aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore9
-rw-r--r--HOWTO/INSTALL-CROSS.md23
-rw-r--r--Makefile.in17
-rw-r--r--OTP_VERSION3
-rw-r--r--bootstrap/bin/start.bootbin5285 -> 5306 bytes
-rw-r--r--bootstrap/bin/start_clean.bootbin5285 -> 5306 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_a.beambin2700 -> 2684 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_asm.beambin11540 -> 11524 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_block.beambin14828 -> 9564 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_bool.beambin16436 -> 15652 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_bs.beambin0 -> 5928 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_bsm.beambin12740 -> 12636 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_clean.beambin9416 -> 8948 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_dead.beambin12156 -> 12972 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_dict.beambin5300 -> 5292 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_disasm.beambin26320 -> 26216 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_except.beambin3564 -> 3540 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_flatten.beambin3020 -> 2996 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_jump.beambin9448 -> 9372 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_listing.beambin2992 -> 2964 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_peep.beambin2780 -> 2424 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_receive.beambin6444 -> 6384 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_reorder.beambin0 -> 1992 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_split.beambin2416 -> 2396 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_trim.beambin7928 -> 7864 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_type.beambin14692 -> 17148 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_utils.beambin13620 -> 13756 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_validator.beambin30304 -> 29988 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_z.beambin2652 -> 2636 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl.beambin32112 -> 31940 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_clauses.beambin2956 -> 2956 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_inline.beambin38940 -> 38716 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_sets.beambin2868 -> 2868 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_trees.beambin20368 -> 20676 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/compile.beambin39368 -> 38704 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/compiler.app4
-rw-r--r--bootstrap/lib/compiler/ebin/compiler.appup2
-rw-r--r--bootstrap/lib/compiler/ebin/core_lib.beambin5240 -> 4408 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_lint.beambin13656 -> 13580 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_parse.beambin50920 -> 50896 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_pp.beambin13252 -> 13148 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_scan.beambin6692 -> 6636 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/rec_env.beambin4772 -> 4920 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_dsetel.beambin7340 -> 7184 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_fold.beambin50072 -> 49728 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_fold_lists.beambin4596 -> 4596 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_inline.beambin4276 -> 4236 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_pre_attributes.beambin3348 -> 3308 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_pre_expand.beambin14940 -> 13472 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_codegen.beambin56912 -> 55864 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_core.beambin53608 -> 53280 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_kernel.beambin47352 -> 46880 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_kernel_pp.beambin12556 -> 12472 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_life.beambin19172 -> 19044 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application.beambin4620 -> 3852 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application_controller.beambin32152 -> 31932 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application_master.beambin6696 -> 6632 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application_starter.beambin1256 -> 1256 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/auth.beambin6552 -> 6516 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/code.beambin7152 -> 7136 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/code_server.beambin28916 -> 22536 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/disk_log.beambin36492 -> 35860 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/disk_log_1.beambin25016 -> 24876 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/disk_log_server.beambin6668 -> 6624 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/dist_ac.beambin26656 -> 26328 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/dist_util.beambin10568 -> 10352 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_boot_server.beambin6012 -> 5964 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_ddll.beambin2916 -> 2908 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_distribution.beambin1832 -> 1832 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_epmd.beambin7092 -> 7068 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_reply.beambin924 -> 920 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/error_handler.beambin1660 -> 1660 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/error_logger.beambin4480 -> 5932 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erts_debug.beambin5460 -> 5548 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/file.beambin14556 -> 14460 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/file_io_server.beambin15728 -> 15564 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/file_server.beambin5436 -> 5408 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/gen_sctp.beambin3636 -> 3612 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/gen_tcp.beambin2416 -> 2404 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/gen_udp.beambin1632 -> 1616 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/global.beambin32764 -> 32252 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/global_group.beambin17740 -> 17568 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/group.beambin14160 -> 14040 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/heart.beambin4072 -> 4128 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/hipe_unified_loader.beambin13768 -> 13712 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet.beambin23420 -> 23320 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet6_sctp.beambin1556 -> 1536 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet6_tcp.beambin3044 -> 3032 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet6_udp.beambin1728 -> 1728 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_config.beambin7796 -> 7728 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_db.beambin27156 -> 27044 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_dns.beambin19764 -> 19596 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_gethost_native.beambin10500 -> 10436 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_hosts.beambin2144 -> 2140 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_parse.beambin12940 -> 12924 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_res.beambin14976 -> 14868 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_sctp.beambin2324 -> 2304 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_tcp.beambin2756 -> 2744 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_tcp_dist.beambin7224 -> 7184 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_udp.beambin1916 -> 1916 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.app6
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.appup8
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.beambin3796 -> 3632 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/kernel_config.beambin2768 -> 2764 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/net_adm.beambin3016 -> 3008 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/net_kernel.beambin22760 -> 22600 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/os.beambin5848 -> 3776 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/pg2.beambin7916 -> 7912 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/ram_file.beambin7044 -> 6996 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/rpc.beambin8616 -> 8580 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/seq_trace.beambin1336 -> 1440 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/standard_error.beambin3864 -> 3864 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/user.beambin11588 -> 11572 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/user_drv.beambin11428 -> 11412 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/user_sup.beambin1764 -> 1752 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/wrap_log_reader.beambin3372 -> 3320 bytes
-rw-r--r--bootstrap/lib/kernel/include/file.hrl31
-rw-r--r--bootstrap/lib/stdlib/ebin/array.beambin12032 -> 12008 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/base64.beambin4544 -> 4540 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/beam_lib.beambin18604 -> 18560 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/binary.beambin3812 -> 2828 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/c.beambin14660 -> 14608 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/calendar.beambin5172 -> 5136 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets.beambin53600 -> 53688 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_server.beambin7028 -> 6988 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_utils.beambin28764 -> 28756 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_v8.beambin27592 -> 27488 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_v9.beambin50200 -> 49844 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dict.beambin9332 -> 9332 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/digraph.beambin8308 -> 8312 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/digraph_utils.beambin6844 -> 6824 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/edlin.beambin10260 -> 10184 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/edlin_expand.beambin3164 -> 3156 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/epp.beambin28220 -> 28208 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_anno.beambin4900 -> 4016 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_bits.beambin2552 -> 2528 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_compile.beambin7324 -> 7280 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_eval.beambin30980 -> 30640 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_expand_records.beambin22536 -> 21764 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_lint.beambin89908 -> 89756 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_parse.beambin84208 -> 82296 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_pp.beambin26912 -> 26796 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_scan.beambin31380 -> 28844 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_tar.beambin17256 -> 17156 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/error_logger_file_h.beambin4708 -> 4656 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/error_logger_tty_h.beambin4976 -> 4936 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/escript.beambin17676 -> 17592 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/ets.beambin22720 -> 22604 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/eval_bits.beambin8136 -> 8096 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/file_sorter.beambin30668 -> 30408 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/filelib.beambin8088 -> 8056 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/filename.beambin12512 -> 12444 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gb_sets.beambin8432 -> 8396 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gb_trees.beambin5176 -> 5128 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen.beambin4296 -> 4276 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_event.beambin19624 -> 13524 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_fsm.beambin17412 -> 10476 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_server.beambin19596 -> 13744 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io.beambin6696 -> 6284 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib.beambin10008 -> 9984 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib_format.beambin13404 -> 13348 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib_fread.beambin7384 -> 7280 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib_pretty.beambin15224 -> 15156 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/lib.beambin9660 -> 9600 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/lists.beambin29708 -> 29768 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/log_mf_h.beambin2672 -> 2636 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/maps.beambin2628 -> 2624 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/ms_transform.beambin20632 -> 20460 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/orddict.beambin2792 -> 2772 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/otp_internal.beambin11536 -> 11896 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/pool.beambin3848 -> 3836 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/proc_lib.beambin10692 -> 10656 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/proplists.beambin4948 -> 4944 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/qlc.beambin70644 -> 70148 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/qlc_pt.beambin76684 -> 76244 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/rand.beambin13448 -> 13560 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/random.beambin1712 -> 1736 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/re.beambin13672 -> 13600 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sets.beambin7096 -> 7060 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/shell.beambin30364 -> 30236 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/slave.beambin5200 -> 4852 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sofs.beambin40816 -> 40656 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/stdlib.app4
-rw-r--r--bootstrap/lib/stdlib/ebin/stdlib.appup8
-rw-r--r--bootstrap/lib/stdlib/ebin/supervisor.beambin24080 -> 23456 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/supervisor_bridge.beambin2908 -> 2072 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sys.beambin8620 -> 8564 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/timer.beambin5488 -> 5476 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/unicode.beambin11616 -> 11612 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/win32reg.beambin5632 -> 5600 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/zip.beambin26840 -> 26632 bytes
-rw-r--r--bootstrap/lib/stdlib/include/erl_bits.hrl10
-rw-r--r--configure.in8
-rw-r--r--erts/aclocal.m448
-rw-r--r--erts/configure.in163
-rw-r--r--erts/doc/src/absform.xml603
-rw-r--r--erts/doc/src/driver_entry.xml17
-rw-r--r--erts/doc/src/erl.xml15
-rw-r--r--erts/doc/src/erl_driver.xml53
-rw-r--r--erts/doc/src/erl_nif.xml2
-rw-r--r--erts/doc/src/erl_prim_loader.xml42
-rw-r--r--erts/doc/src/erlang.xml313
-rw-r--r--erts/doc/src/init.xml5
-rw-r--r--erts/doc/src/run_erl.xml2
-rw-r--r--erts/emulator/Makefile.in65
-rw-r--r--erts/emulator/beam/atom.c5
-rw-r--r--erts/emulator/beam/atom.h1
-rw-r--r--erts/emulator/beam/atom.names22
-rw-r--r--erts/emulator/beam/beam_bif_load.c480
-rw-r--r--erts/emulator/beam/beam_bp.c32
-rw-r--r--erts/emulator/beam/beam_debug.c144
-rw-r--r--erts/emulator/beam/beam_emu.c1993
-rw-r--r--erts/emulator/beam/beam_load.c673
-rw-r--r--erts/emulator/beam/beam_load.h127
-rw-r--r--erts/emulator/beam/beam_ranges.c50
-rw-r--r--erts/emulator/beam/bif.c337
-rw-r--r--erts/emulator/beam/bif.h48
-rw-r--r--erts/emulator/beam/bif.tab18
-rw-r--r--erts/emulator/beam/big.c455
-rw-r--r--erts/emulator/beam/big.h23
-rw-r--r--erts/emulator/beam/binary.c81
-rw-r--r--erts/emulator/beam/break.c34
-rw-r--r--erts/emulator/beam/copy.c1399
-rw-r--r--erts/emulator/beam/dist.c72
-rw-r--r--erts/emulator/beam/erl_alloc.c267
-rw-r--r--erts/emulator/beam/erl_alloc.h52
-rw-r--r--erts/emulator/beam/erl_alloc.types58
-rw-r--r--erts/emulator/beam/erl_alloc_util.c360
-rw-r--r--erts/emulator/beam/erl_alloc_util.h69
-rw-r--r--erts/emulator/beam/erl_arith.c11
-rw-r--r--erts/emulator/beam/erl_async.c35
-rw-r--r--erts/emulator/beam/erl_bif_binary.c953
-rw-r--r--erts/emulator/beam/erl_bif_ddll.c17
-rw-r--r--erts/emulator/beam/erl_bif_info.c384
-rw-r--r--erts/emulator/beam/erl_bif_lists.c8
-rw-r--r--erts/emulator/beam/erl_bif_op.c14
-rw-r--r--erts/emulator/beam/erl_bif_port.c62
-rw-r--r--erts/emulator/beam/erl_bif_re.c4
-rw-r--r--erts/emulator/beam/erl_bif_trace.c26
-rw-r--r--erts/emulator/beam/erl_bif_unique.c6
-rw-r--r--erts/emulator/beam/erl_binary.h15
-rw-r--r--erts/emulator/beam/erl_bits.c4
-rw-r--r--erts/emulator/beam/erl_db.c17
-rw-r--r--erts/emulator/beam/erl_db_hash.c16
-rw-r--r--erts/emulator/beam/erl_db_tree.c238
-rw-r--r--erts/emulator/beam/erl_db_util.c377
-rw-r--r--erts/emulator/beam/erl_db_util.h15
-rw-r--r--erts/emulator/beam/erl_debug.c37
-rw-r--r--erts/emulator/beam/erl_debug.h7
-rw-r--r--erts/emulator/beam/erl_driver.h41
-rw-r--r--erts/emulator/beam/erl_fun.c3
-rw-r--r--erts/emulator/beam/erl_gc.c1467
-rw-r--r--erts/emulator/beam/erl_gc.h43
-rw-r--r--erts/emulator/beam/erl_hl_timer.c102
-rw-r--r--erts/emulator/beam/erl_init.c89
-rw-r--r--erts/emulator/beam/erl_lock_check.c8
-rw-r--r--erts/emulator/beam/erl_map.c124
-rw-r--r--erts/emulator/beam/erl_map.h19
-rw-r--r--erts/emulator/beam/erl_message.c1658
-rw-r--r--erts/emulator/beam/erl_message.h285
-rw-r--r--erts/emulator/beam/erl_msacc.c486
-rw-r--r--erts/emulator/beam/erl_msacc.h409
-rw-r--r--erts/emulator/beam/erl_nif.c57
-rw-r--r--erts/emulator/beam/erl_nif.h27
-rw-r--r--erts/emulator/beam/erl_node_container_utils.h4
-rw-r--r--erts/emulator/beam/erl_node_tables.c95
-rw-r--r--erts/emulator/beam/erl_node_tables.h3
-rw-r--r--erts/emulator/beam/erl_port.h12
-rw-r--r--erts/emulator/beam/erl_port_task.c5
-rw-r--r--erts/emulator/beam/erl_printf_term.c31
-rw-r--r--erts/emulator/beam/erl_printf_term.h3
-rw-r--r--erts/emulator/beam/erl_process.c1292
-rw-r--r--erts/emulator/beam/erl_process.h181
-rw-r--r--erts/emulator/beam/erl_process_dict.c255
-rw-r--r--erts/emulator/beam/erl_process_dict.h11
-rw-r--r--erts/emulator/beam/erl_process_dump.c31
-rw-r--r--erts/emulator/beam/erl_term.c37
-rw-r--r--erts/emulator/beam/erl_term.h237
-rw-r--r--erts/emulator/beam/erl_threads.h34
-rw-r--r--erts/emulator/beam/erl_time.h2
-rw-r--r--erts/emulator/beam/erl_time_sup.c21
-rw-r--r--erts/emulator/beam/erl_trace.c162
-rw-r--r--erts/emulator/beam/erl_utils.h69
-rw-r--r--erts/emulator/beam/erl_vm.h15
-rw-r--r--erts/emulator/beam/export.c3
-rw-r--r--erts/emulator/beam/external.c80
-rw-r--r--erts/emulator/beam/global.h398
-rw-r--r--erts/emulator/beam/hash.c142
-rw-r--r--erts/emulator/beam/hash.h31
-rw-r--r--erts/emulator/beam/index.h4
-rw-r--r--erts/emulator/beam/io.c366
-rw-r--r--erts/emulator/beam/module.c7
-rw-r--r--erts/emulator/beam/module.h2
-rw-r--r--erts/emulator/beam/ops.tab875
-rw-r--r--erts/emulator/beam/register.c3
-rw-r--r--erts/emulator/beam/sys.h127
-rw-r--r--erts/emulator/beam/time.c20
-rw-r--r--erts/emulator/beam/utils.c355
-rw-r--r--erts/emulator/drivers/common/efile_drv.c10
-rw-r--r--erts/emulator/drivers/common/inet_drv.c573
-rw-r--r--erts/emulator/drivers/ose/ose_efile.c1125
-rw-r--r--erts/emulator/drivers/ose/ose_signal_drv.c897
-rw-r--r--erts/emulator/drivers/ose/ttsl_drv.c69
-rw-r--r--erts/emulator/hipe/hipe_bif0.c24
-rw-r--r--erts/emulator/hipe/hipe_gc.c36
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.c2
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.h2
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c36
-rw-r--r--erts/emulator/hipe/hipe_x86_signal.c201
-rw-r--r--erts/emulator/sys/common/erl_check_io.c24
-rw-r--r--erts/emulator/sys/common/erl_mmap.c582
-rw-r--r--erts/emulator/sys/common/erl_mmap.h30
-rw-r--r--erts/emulator/sys/common/erl_mseg.c389
-rw-r--r--erts/emulator/sys/common/erl_mseg.h19
-rw-r--r--erts/emulator/sys/common/erl_poll.c36
-rw-r--r--erts/emulator/sys/common/erl_poll.h22
-rw-r--r--erts/emulator/sys/ose/beam.lmconf26
-rw-r--r--erts/emulator/sys/ose/driver_int.h42
-rw-r--r--erts/emulator/sys/ose/erl_main.c54
-rw-r--r--erts/emulator/sys/ose/erl_ose_sys.h356
-rw-r--r--erts/emulator/sys/ose/erl_ose_sys_ddll.c127
-rw-r--r--erts/emulator/sys/ose/erl_poll.c818
-rw-r--r--erts/emulator/sys/ose/erts.sig17
-rw-r--r--erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf182
-rw-r--r--erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf242
-rw-r--r--erts/emulator/sys/ose/sys.c1847
-rw-r--r--erts/emulator/sys/ose/sys_float.c845
-rw-r--r--erts/emulator/sys/ose/sys_time.c57
-rw-r--r--erts/emulator/sys/unix/erl_child_setup.c559
-rw-r--r--erts/emulator/sys/unix/erl_child_setup.h77
-rw-r--r--erts/emulator/sys/unix/erl_unix_sys.h55
-rw-r--r--erts/emulator/sys/unix/sys.c1937
-rw-r--r--erts/emulator/sys/unix/sys_drivers.c1862
-rw-r--r--erts/emulator/sys/unix/sys_time.c114
-rw-r--r--erts/emulator/sys/unix/sys_uds.c155
-rw-r--r--erts/emulator/sys/unix/sys_uds.h57
-rw-r--r--erts/emulator/sys/win32/erl_poll.c4
-rw-r--r--erts/emulator/sys/win32/erl_win_sys.h14
-rw-r--r--erts/emulator/sys/win32/sys.c14
-rw-r--r--erts/emulator/sys/win32/sys_time.c1
-rw-r--r--erts/emulator/test/Makefile3
-rw-r--r--erts/emulator/test/a_SUITE.erl2
-rw-r--r--erts/emulator/test/after_SUITE.erl2
-rw-r--r--erts/emulator/test/alloc_SUITE.erl17
-rw-r--r--erts/emulator/test/alloc_SUITE_data/threads.c17
-rw-r--r--erts/emulator/test/beam_SUITE.erl2
-rw-r--r--erts/emulator/test/beam_literals_SUITE.erl2
-rw-r--r--erts/emulator/test/bif_SUITE.erl23
-rw-r--r--erts/emulator/test/big_SUITE.erl2
-rw-r--r--erts/emulator/test/binary_SUITE.erl41
-rw-r--r--erts/emulator/test/bs_bincomp_SUITE.erl2
-rw-r--r--erts/emulator/test/bs_bit_binaries_SUITE.erl2
-rw-r--r--erts/emulator/test/bs_construct_SUITE.erl2
-rw-r--r--erts/emulator/test/bs_match_bin_SUITE.erl2
-rw-r--r--erts/emulator/test/bs_match_int_SUITE.erl2
-rw-r--r--erts/emulator/test/bs_match_misc_SUITE.erl2
-rw-r--r--erts/emulator/test/bs_match_tail_SUITE.erl2
-rw-r--r--erts/emulator/test/bs_utf_SUITE.erl2
-rw-r--r--erts/emulator/test/busy_port_SUITE.erl2
-rw-r--r--erts/emulator/test/call_trace_SUITE.erl2
-rw-r--r--erts/emulator/test/code_SUITE.erl84
-rw-r--r--erts/emulator/test/code_SUITE_data/literals.erl7
-rw-r--r--erts/emulator/test/code_parallel_load_SUITE.erl2
-rw-r--r--erts/emulator/test/crypto_SUITE.erl2
-rw-r--r--erts/emulator/test/ddll_SUITE.erl2
-rw-r--r--erts/emulator/test/decode_packet_SUITE.erl49
-rw-r--r--erts/emulator/test/distribution_SUITE.erl2
-rw-r--r--erts/emulator/test/driver_SUITE.erl55
-rw-r--r--erts/emulator/test/efile_SUITE.erl2
-rw-r--r--erts/emulator/test/emulator.spec.ose2
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE.erl2
-rw-r--r--erts/emulator/test/erl_link_SUITE.erl2
-rw-r--r--erts/emulator/test/erts_debug_SUITE.erl47
-rw-r--r--erts/emulator/test/estone_SUITE.erl2
-rw-r--r--erts/emulator/test/evil_SUITE.erl6
-rw-r--r--erts/emulator/test/exception_SUITE.erl2
-rw-r--r--erts/emulator/test/float_SUITE.erl126
-rw-r--r--erts/emulator/test/float_SUITE_data/fp_drv.c1
-rw-r--r--erts/emulator/test/fun_SUITE.erl2
-rw-r--r--erts/emulator/test/fun_r13_SUITE.erl2
-rw-r--r--erts/emulator/test/gc_SUITE.erl2
-rw-r--r--erts/emulator/test/guard_SUITE.erl2
-rw-r--r--erts/emulator/test/hash_SUITE.erl12
-rw-r--r--erts/emulator/test/hibernate_SUITE.erl2
-rw-r--r--erts/emulator/test/ignore_cores.erl2
-rw-r--r--erts/emulator/test/list_bif_SUITE.erl2
-rw-r--r--erts/emulator/test/map_SUITE.erl31
-rw-r--r--erts/emulator/test/match_spec_SUITE.erl2
-rw-r--r--erts/emulator/test/message_queue_data_SUITE.erl239
-rw-r--r--erts/emulator/test/module_info_SUITE.erl2
-rw-r--r--erts/emulator/test/monitor_SUITE.erl2
-rw-r--r--erts/emulator/test/nested_SUITE.erl2
-rw-r--r--erts/emulator/test/nif_SUITE.erl25
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c6
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.erl2
-rw-r--r--erts/emulator/test/nif_SUITE_data/tester.erl2
-rw-r--r--erts/emulator/test/node_container_SUITE.erl2
-rw-r--r--erts/emulator/test/nofrag_SUITE.erl2
-rw-r--r--erts/emulator/test/num_bif_SUITE.erl101
-rw-r--r--erts/emulator/test/old_mod.erl2
-rw-r--r--erts/emulator/test/old_scheduler_SUITE.erl2
-rw-r--r--erts/emulator/test/op_SUITE.erl25
-rw-r--r--erts/emulator/test/port_SUITE.erl143
-rw-r--r--erts/emulator/test/port_SUITE_data/port_test.c35
-rw-r--r--erts/emulator/test/port_bif_SUITE.erl11
-rw-r--r--erts/emulator/test/process_SUITE.erl49
-rw-r--r--erts/emulator/test/random_iolist.erl16
-rw-r--r--erts/emulator/test/receive_SUITE.erl2
-rw-r--r--erts/emulator/test/ref_SUITE.erl2
-rw-r--r--erts/emulator/test/register_SUITE.erl2
-rw-r--r--erts/emulator/test/save_calls_SUITE.erl6
-rw-r--r--erts/emulator/test/scheduler_SUITE.erl52
-rw-r--r--erts/emulator/test/scheduler_SUITE_data/Makefile.src8
-rw-r--r--erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c31
-rw-r--r--erts/emulator/test/send_term_SUITE.erl2
-rw-r--r--erts/emulator/test/sensitive_SUITE.erl2
-rw-r--r--erts/emulator/test/signal_SUITE.erl2
-rw-r--r--erts/emulator/test/smoke_test_SUITE.erl2
-rw-r--r--erts/emulator/test/statistics_SUITE.erl118
-rw-r--r--erts/emulator/test/system_info_SUITE.erl4
-rw-r--r--erts/emulator/test/system_profile_SUITE.erl4
-rw-r--r--erts/emulator/test/time_SUITE.erl38
-rw-r--r--erts/emulator/test/timer_bif_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_SUITE.erl6
-rw-r--r--erts/emulator/test/trace_bif_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_call_count_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_call_time_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_local_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_meta_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_nif_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_port_SUITE.erl2
-rw-r--r--erts/emulator/test/tuple_SUITE.erl2
-rw-r--r--erts/emulator/test/unique_SUITE.erl17
-rw-r--r--erts/emulator/test/z_SUITE.erl40
-rwxr-xr-xerts/emulator/utils/beam_makeops89
-rw-r--r--erts/emulator/valgrind/suppress.halfword56
-rw-r--r--erts/epmd/src/Makefile.in37
-rw-r--r--erts/epmd/src/epmd.c2
-rw-r--r--erts/epmd/src/epmd_int.h18
-rw-r--r--erts/epmd/src/epmd_srv.c7
-rw-r--r--erts/epmd/test/epmd_SUITE.erl2
-rw-r--r--erts/etc/common/Makefile.in83
-rw-r--r--erts/etc/common/erlexec.c22
-rw-r--r--erts/etc/common/run_erl_common.c696
-rw-r--r--erts/etc/common/run_erl_common.h97
-rw-r--r--erts/etc/common/to_erl_common.c717
-rw-r--r--erts/etc/common/to_erl_common.h29
-rw-r--r--erts/etc/ose/etc.lmconf20
-rw-r--r--erts/etc/ose/run_erl.c664
-rw-r--r--erts/etc/ose/run_erl.h30
-rw-r--r--erts/etc/ose/run_erl_main.c80
-rw-r--r--erts/etc/unix/etp-commands.in16
-rw-r--r--erts/etc/unix/run_erl.c610
-rw-r--r--erts/etc/unix/run_erl.h (renamed from erts/etc/common/run_erl_vsn.h)7
-rw-r--r--erts/etc/unix/safe_string.c (renamed from erts/etc/common/safe_string.c)11
-rw-r--r--erts/etc/unix/safe_string.h (renamed from erts/etc/common/safe_string.h)11
-rw-r--r--erts/etc/unix/to_erl.c591
-rw-r--r--erts/include/erl_int_sizes_config.h.in3
-rw-r--r--erts/include/internal/erl_printf_format.h11
-rw-r--r--erts/include/internal/ethr_internal.h1
-rw-r--r--erts/include/internal/ethr_mutex.h8
-rw-r--r--erts/include/internal/ethread.h143
-rw-r--r--erts/include/internal/ose/ethr_event.h114
-rw-r--r--erts/lib_src/common/erl_misc_utils.c6
-rw-r--r--erts/lib_src/common/erl_printf_format.c25
-rw-r--r--erts/lib_src/common/ethr_aux.c47
-rw-r--r--erts/lib_src/common/ethr_mutex.c2
-rw-r--r--erts/lib_src/ose/ethr_event.c220
-rw-r--r--erts/lib_src/ose/ethread.c833
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin56336 -> 49836 bytes
-rw-r--r--erts/preloaded/ebin/erlang.beambin102116 -> 101968 bytes
-rw-r--r--erts/preloaded/ebin/erts_code_purger.beambin0 -> 8704 bytes
-rw-r--r--erts/preloaded/ebin/erts_internal.beambin6516 -> 9976 bytes
-rw-r--r--erts/preloaded/ebin/init.beambin48764 -> 44588 bytes
-rw-r--r--erts/preloaded/ebin/otp_ring0.beambin1468 -> 1448 bytes
-rw-r--r--erts/preloaded/ebin/prim_eval.beambin1340 -> 1320 bytes
-rw-r--r--erts/preloaded/ebin/prim_file.beambin44980 -> 44800 bytes
-rw-r--r--erts/preloaded/ebin/prim_inet.beambin72716 -> 72608 bytes
-rw-r--r--erts/preloaded/ebin/prim_zip.beambin23424 -> 23156 bytes
-rw-r--r--erts/preloaded/ebin/zlib.beambin14176 -> 14156 bytes
-rw-r--r--erts/preloaded/src/Makefile1
-rw-r--r--erts/preloaded/src/erl_prim_loader.erl408
-rw-r--r--erts/preloaded/src/erlang.erl133
-rw-r--r--erts/preloaded/src/erts.app.src1
-rw-r--r--erts/preloaded/src/erts_code_purger.erl299
-rw-r--r--erts/preloaded/src/erts_internal.erl150
-rw-r--r--erts/preloaded/src/init.erl401
-rw-r--r--erts/test/Makefile2
-rw-r--r--erts/test/erl_print_SUITE.erl2
-rw-r--r--erts/test/erlc_SUITE.erl2
-rw-r--r--erts/test/erlexec_SUITE.erl2
-rw-r--r--erts/test/ethread_SUITE.erl34
-rw-r--r--erts/test/ignore_cores.erl2
-rw-r--r--erts/test/install_SUITE.erl2
-rw-r--r--erts/test/nt_SUITE.erl2
-rw-r--r--erts/test/otp_SUITE.erl29
-rw-r--r--erts/test/run_erl_SUITE.erl20
-rw-r--r--erts/vsn.mk2
-rw-r--r--lib/Makefile7
-rw-r--r--lib/asn1/c_src/Makefile7
-rw-r--r--lib/asn1/src/asn1ct_value.erl5
-rw-r--r--lib/asn1/test/asn1_SUITE.erl2
-rw-r--r--lib/asn1/test/asn1_SUITE_data/test_records.erl3
-rw-r--r--lib/asn1/test/asn1_test_lib.erl2
-rw-r--r--lib/asn1/test/error_SUITE.erl2
-rw-r--r--lib/asn1/test/h323test.erl2
-rw-r--r--lib/asn1/test/syntax_SUITE.erl2
-rw-r--r--lib/asn1/test/testChoExtension.erl2
-rw-r--r--lib/asn1/test/testChoExternal.erl2
-rw-r--r--lib/asn1/test/testChoPrim.erl2
-rw-r--r--lib/asn1/test/testChoRecursive.erl2
-rw-r--r--lib/asn1/test/testChoTypeRefCho.erl2
-rw-r--r--lib/asn1/test/testChoTypeRefPrim.erl2
-rw-r--r--lib/asn1/test/testChoTypeRefSeq.erl2
-rw-r--r--lib/asn1/test/testChoTypeRefSet.erl2
-rw-r--r--lib/asn1/test/testChoiceIndefinite.erl2
-rw-r--r--lib/asn1/test/testConstraints.erl2
-rw-r--r--lib/asn1/test/testContextSwitchingTypes.erl2
-rw-r--r--lib/asn1/test/testDER.erl2
-rw-r--r--lib/asn1/test/testDeepTConstr.erl2
-rw-r--r--lib/asn1/test/testDef.erl2
-rw-r--r--lib/asn1/test/testDoubleEllipses.erl2
-rw-r--r--lib/asn1/test/testEnumExt.erl2
-rw-r--r--lib/asn1/test/testINSTANCE_OF.erl2
-rw-r--r--lib/asn1/test/testInfObjectClass.erl2
-rw-r--r--lib/asn1/test/testMegaco.erl2
-rw-r--r--lib/asn1/test/testMergeCompile.erl2
-rw-r--r--lib/asn1/test/testNBAPsystem.erl2
-rw-r--r--lib/asn1/test/testOpenTypeImplicitTag.erl2
-rw-r--r--lib/asn1/test/testOpt.erl2
-rw-r--r--lib/asn1/test/testParamBasic.erl2
-rw-r--r--lib/asn1/test/testParameterizedInfObj.erl2
-rw-r--r--lib/asn1/test/testPrim.erl2
-rw-r--r--lib/asn1/test/testPrimExternal.erl2
-rw-r--r--lib/asn1/test/testPrimStrings.erl4
-rw-r--r--lib/asn1/test/testRfcs.erl2
-rw-r--r--lib/asn1/test/testSSLspecs.erl2
-rw-r--r--lib/asn1/test/testSelectionTypes.erl2
-rw-r--r--lib/asn1/test/testSeq2738.erl2
-rw-r--r--lib/asn1/test/testSeqDefault.erl2
-rw-r--r--lib/asn1/test/testSeqExtension.erl2
-rw-r--r--lib/asn1/test/testSeqExternal.erl2
-rw-r--r--lib/asn1/test/testSeqOf.erl2
-rw-r--r--lib/asn1/test/testSeqOfCho.erl2
-rw-r--r--lib/asn1/test/testSeqOfExternal.erl2
-rw-r--r--lib/asn1/test/testSeqOfIndefinite.erl2
-rw-r--r--lib/asn1/test/testSeqOfTag.erl2
-rw-r--r--lib/asn1/test/testSeqOptional.erl2
-rw-r--r--lib/asn1/test/testSeqPrim.erl2
-rw-r--r--lib/asn1/test/testSeqSetDefaultVal.erl2
-rw-r--r--lib/asn1/test/testSeqSetIndefinite.erl2
-rw-r--r--lib/asn1/test/testSeqTag.erl2
-rw-r--r--lib/asn1/test/testSeqTypeRefCho.erl2
-rw-r--r--lib/asn1/test/testSeqTypeRefPrim.erl2
-rw-r--r--lib/asn1/test/testSeqTypeRefSeq.erl2
-rw-r--r--lib/asn1/test/testSeqTypeRefSet.erl2
-rw-r--r--lib/asn1/test/testSetDefault.erl2
-rw-r--r--lib/asn1/test/testSetExtension.erl2
-rw-r--r--lib/asn1/test/testSetExternal.erl2
-rw-r--r--lib/asn1/test/testSetOf.erl2
-rw-r--r--lib/asn1/test/testSetOfCho.erl2
-rw-r--r--lib/asn1/test/testSetOfExternal.erl2
-rw-r--r--lib/asn1/test/testSetOfTag.erl2
-rw-r--r--lib/asn1/test/testSetPrim.erl2
-rw-r--r--lib/asn1/test/testSetTag.erl2
-rw-r--r--lib/asn1/test/testSetTypeRefCho.erl2
-rw-r--r--lib/asn1/test/testSetTypeRefPrim.erl2
-rw-r--r--lib/asn1/test/testSetTypeRefSeq.erl2
-rw-r--r--lib/asn1/test/testSetTypeRefSet.erl2
-rw-r--r--lib/asn1/test/testTCAP.erl2
-rw-r--r--lib/asn1/test/testTimer.erl2
-rw-r--r--lib/asn1/test/test_compile_options.erl2
-rw-r--r--lib/asn1/test/test_modified_x420.erl2
-rw-r--r--lib/asn1/test/test_partial_incomplete_decode.erl2
-rw-r--r--lib/asn1/test/test_selective_decode.erl2
-rw-r--r--lib/asn1/test/test_special_decode_performance.erl2
-rw-r--r--lib/asn1/test/test_undecoded_rest.erl2
-rw-r--r--lib/asn1/test/test_x691.erl2
-rw-r--r--lib/common_test/include/ct.hrl8
-rw-r--r--lib/common_test/src/Makefile13
-rw-r--r--lib/common_test/src/ct_config.erl3
-rw-r--r--lib/common_test/src/ct_make.erl7
-rw-r--r--lib/common_test/src/ct_run.erl4
-rw-r--r--lib/common_test/src/erl2html2.erl (renamed from lib/test_server/src/erl2html2.erl)31
-rw-r--r--lib/common_test/src/test_server.app.src (renamed from lib/test_server/src/test_server.app.src)0
-rw-r--r--lib/common_test/src/test_server.appup.src (renamed from lib/test_server/src/test_server.appup.src)0
-rw-r--r--lib/common_test/src/test_server.erl (renamed from lib/test_server/src/test_server.erl)0
-rw-r--r--lib/common_test/src/test_server_ctrl.erl (renamed from lib/test_server/src/test_server_ctrl.erl)14
-rw-r--r--lib/common_test/src/test_server_gl.erl (renamed from lib/test_server/src/test_server_gl.erl)4
-rw-r--r--lib/common_test/src/test_server_internal.hrl (renamed from lib/test_server/src/test_server_internal.hrl)0
-rw-r--r--lib/common_test/src/test_server_io.erl (renamed from lib/test_server/src/test_server_io.erl)0
-rw-r--r--lib/common_test/src/test_server_node.erl (renamed from lib/test_server/src/test_server_node.erl)3
-rw-r--r--lib/common_test/src/test_server_sup.erl (renamed from lib/test_server/src/test_server_sup.erl)0
-rw-r--r--lib/common_test/test/Makefile12
-rw-r--r--lib/common_test/test/common_test.cover7
-rw-r--r--lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl2
-rw-r--r--lib/common_test/test/ct_hooks_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_master_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_misc_1_SUITE.erl1
-rw-r--r--lib/common_test/test/ct_test_support.erl8
-rw-r--r--lib/common_test/test/ct_test_support_eh.erl2
-rw-r--r--lib/common_test/test/erl2html2_SUITE.erl (renamed from lib/test_server/test/erl2html2_SUITE.erl)0
-rw-r--r--lib/common_test/test/erl2html2_SUITE_data/Makefile.src (renamed from lib/test_server/test/erl2html2_SUITE_data/Makefile.src)0
-rw-r--r--lib/common_test/test/erl2html2_SUITE_data/header1.hrl (renamed from lib/test_server/test/erl2html2_SUITE_data/header1.hrl)0
-rw-r--r--lib/common_test/test/erl2html2_SUITE_data/include/header2.hrl (renamed from lib/test_server/test/erl2html2_SUITE_data/include/header2.hrl)0
-rw-r--r--lib/common_test/test/erl2html2_SUITE_data/include/header3.hrl (renamed from lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl)0
-rw-r--r--lib/common_test/test/erl2html2_SUITE_data/m1.erl (renamed from lib/test_server/test/erl2html2_SUITE_data/m1.erl)0
-rw-r--r--lib/common_test/test/test_server_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE.erl)4
-rw-r--r--lib/common_test/test/test_server_SUITE_data/Makefile.src (renamed from lib/test_server/test/test_server_SUITE_data/Makefile.src)0
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl)3
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file (renamed from lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file)0
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_break_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl)2
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_conf01_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl)2
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_conf02_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl)2
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl)2
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl)0
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl)2
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl)21
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_skip_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl)3
-rw-r--r--lib/common_test/test/test_server_SUITE_data/test_server_unicode_SUITE.erl (renamed from lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl)2
-rw-r--r--lib/common_test/test/test_server_test_lib.erl (renamed from lib/test_server/test/test_server_test_lib.erl)0
-rw-r--r--lib/common_test/test/test_server_test_lib.hrl (renamed from lib/test_server/test/test_server_test_lib.hrl)0
-rw-r--r--lib/common_test/test_server/Makefile (renamed from lib/webtool/src/Makefile)82
-rw-r--r--lib/common_test/test_server/conf_vars.in (renamed from lib/test_server/src/conf_vars.in)0
-rw-r--r--lib/common_test/test_server/configure.in (renamed from lib/test_server/src/configure.in)0
-rw-r--r--lib/common_test/test_server/cross.cover (renamed from lib/test_server/src/cross.cover)0
-rw-r--r--lib/common_test/test_server/ts.config (renamed from lib/test_server/src/ts.config)0
-rw-r--r--lib/common_test/test_server/ts.erl (renamed from lib/test_server/src/ts.erl)0
-rw-r--r--lib/common_test/test_server/ts.hrl (renamed from lib/test_server/src/ts.hrl)0
-rw-r--r--lib/common_test/test_server/ts.unix.config (renamed from lib/test_server/src/ts.unix.config)0
-rw-r--r--lib/common_test/test_server/ts.win32.config (renamed from lib/test_server/src/ts.win32.config)0
-rw-r--r--lib/common_test/test_server/ts_autoconf_win32.erl (renamed from lib/test_server/src/ts_autoconf_win32.erl)0
-rw-r--r--lib/common_test/test_server/ts_benchmark.erl (renamed from lib/test_server/src/ts_benchmark.erl)0
-rw-r--r--lib/common_test/test_server/ts_erl_config.erl (renamed from lib/test_server/src/ts_erl_config.erl)0
-rw-r--r--lib/common_test/test_server/ts_install.erl (renamed from lib/test_server/src/ts_install.erl)0
-rw-r--r--lib/common_test/test_server/ts_install_cth.erl (renamed from lib/test_server/src/ts_install_cth.erl)0
-rw-r--r--lib/common_test/test_server/ts_lib.erl (renamed from lib/test_server/src/ts_lib.erl)0
-rw-r--r--lib/common_test/test_server/ts_make.erl (renamed from lib/test_server/src/ts_make.erl)2
-rw-r--r--lib/common_test/test_server/ts_run.erl (renamed from lib/test_server/src/ts_run.erl)0
-rw-r--r--lib/compiler/src/Makefile2
-rw-r--r--lib/compiler/src/beam_asm.erl5
-rw-r--r--lib/compiler/src/beam_block.erl484
-rw-r--r--lib/compiler/src/beam_bool.erl2
-rw-r--r--lib/compiler/src/beam_bs.erl278
-rw-r--r--lib/compiler/src/beam_clean.erl22
-rw-r--r--lib/compiler/src/beam_dead.erl57
-rw-r--r--lib/compiler/src/beam_dict.erl11
-rw-r--r--lib/compiler/src/beam_jump.erl2
-rw-r--r--lib/compiler/src/beam_peep.erl44
-rw-r--r--lib/compiler/src/beam_reorder.erl139
-rw-r--r--lib/compiler/src/beam_split.erl4
-rw-r--r--lib/compiler/src/beam_type.erl156
-rw-r--r--lib/compiler/src/beam_utils.erl9
-rw-r--r--lib/compiler/src/beam_validator.erl57
-rw-r--r--lib/compiler/src/cerl_trees.erl223
-rw-r--r--lib/compiler/src/compile.erl39
-rw-r--r--lib/compiler/src/compiler.app.src2
-rw-r--r--lib/compiler/src/core_lib.erl38
-rw-r--r--lib/compiler/src/core_lint.erl4
-rw-r--r--lib/compiler/src/rec_env.erl11
-rw-r--r--lib/compiler/src/sys_core_dsetel.erl36
-rw-r--r--lib/compiler/src/sys_core_fold.erl6
-rw-r--r--lib/compiler/src/sys_pre_expand.erl179
-rw-r--r--lib/compiler/src/v3_codegen.erl25
-rw-r--r--lib/compiler/src/v3_core.erl47
-rw-r--r--lib/compiler/src/v3_kernel.erl21
-rw-r--r--lib/compiler/test/Makefile6
-rw-r--r--lib/compiler/test/andor_SUITE.erl2
-rw-r--r--lib/compiler/test/apply_SUITE.erl2
-rw-r--r--lib/compiler/test/beam_disasm_SUITE.erl2
-rw-r--r--lib/compiler/test/beam_reorder_SUITE.erl69
-rw-r--r--lib/compiler/test/beam_type_SUITE.erl98
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl8
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/xrange.S4
-rw-r--r--lib/compiler/test/bs_bincomp_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_bit_binaries_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl38
-rw-r--r--lib/compiler/test/bs_utf_SUITE.erl2
-rw-r--r--lib/compiler/test/compilation_SUITE.erl2
-rw-r--r--lib/compiler/test/compile_SUITE.erl101
-rw-r--r--lib/compiler/test/compile_SUITE_data/bad_record_use.erl29
-rw-r--r--lib/compiler/test/compile_SUITE_data/bad_record_use2.erl30
-rw-r--r--lib/compiler/test/core_SUITE.erl2
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl2
-rw-r--r--lib/compiler/test/error_SUITE.erl2
-rw-r--r--lib/compiler/test/float_SUITE.erl2
-rw-r--r--lib/compiler/test/fun_SUITE.erl2
-rw-r--r--lib/compiler/test/guard_SUITE.erl2
-rw-r--r--lib/compiler/test/inline_SUITE.erl2
-rw-r--r--lib/compiler/test/lc_SUITE.erl2
-rw-r--r--lib/compiler/test/map_SUITE.erl22
-rw-r--r--lib/compiler/test/match_SUITE.erl9
-rw-r--r--lib/compiler/test/misc_SUITE.erl24
-rw-r--r--lib/compiler/test/num_bif_SUITE.erl2
-rw-r--r--lib/compiler/test/receive_SUITE.erl2
-rw-r--r--lib/compiler/test/record_SUITE.erl2
-rw-r--r--lib/compiler/test/regressions_SUITE.erl2
-rw-r--r--lib/compiler/test/test_lib.erl2
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl2
-rw-r--r--lib/compiler/test/warnings_SUITE.erl2
-rw-r--r--lib/cosEvent/test/Makefile4
-rw-r--r--lib/cosEvent/test/event_channel_SUITE.erl2
-rw-r--r--lib/cosEvent/test/generated_SUITE.erl2
-rw-r--r--lib/cosEventDomain/test/Makefile4
-rw-r--r--lib/cosEventDomain/test/event_domain_SUITE.erl2
-rw-r--r--lib/cosEventDomain/test/generated_SUITE.erl2
-rw-r--r--lib/cosFileTransfer/test/Makefile4
-rw-r--r--lib/cosFileTransfer/test/fileTransfer_SUITE.erl2
-rw-r--r--lib/cosNotification/test/Makefile4
-rw-r--r--lib/cosNotification/test/eventDB_SUITE.erl2
-rw-r--r--lib/cosNotification/test/generated_SUITE.erl2
-rw-r--r--lib/cosNotification/test/grammar_SUITE.erl2
-rw-r--r--lib/cosNotification/test/notification_SUITE.erl2
-rw-r--r--lib/cosProperty/test/Makefile4
-rw-r--r--lib/cosProperty/test/generated_SUITE.erl2
-rw-r--r--lib/cosProperty/test/property_SUITE.erl2
-rw-r--r--lib/cosTime/test/Makefile4
-rw-r--r--lib/cosTime/test/generated_SUITE.erl2
-rw-r--r--lib/cosTime/test/time_SUITE.erl2
-rw-r--r--lib/cosTransactions/test/Makefile4
-rw-r--r--lib/cosTransactions/test/generated_SUITE.erl2
-rw-r--r--lib/cosTransactions/test/transactions_SUITE.erl2
-rw-r--r--lib/crypto/Makefile4
-rw-r--r--lib/crypto/c_src/Makefile.in7
-rw-r--r--lib/crypto/c_src/crypto.c2779
-rw-r--r--lib/crypto/c_src/crypto_callback.c8
-rw-r--r--lib/crypto/doc/src/crypto.xml10
-rw-r--r--lib/crypto/src/crypto.erl855
-rw-r--r--lib/crypto/test/Makefile2
-rw-r--r--lib/crypto/test/blowfish_SUITE.erl3
-rw-r--r--lib/crypto/test/crypto_SUITE.erl90
-rw-r--r--lib/crypto/test/old_crypto_SUITE.erl2
-rw-r--r--lib/debugger/src/dbg_iload.erl4
-rw-r--r--lib/debugger/src/dbg_wx_win.erl7
-rw-r--r--lib/debugger/test/Makefile2
-rw-r--r--lib/debugger/test/andor_SUITE.erl2
-rw-r--r--lib/debugger/test/bs_bincomp_SUITE.erl2
-rw-r--r--lib/debugger/test/bs_construct_SUITE.erl2
-rw-r--r--lib/debugger/test/bs_match_bin_SUITE.erl2
-rw-r--r--lib/debugger/test/bs_match_int_SUITE.erl2
-rw-r--r--lib/debugger/test/bs_match_misc_SUITE.erl2
-rw-r--r--lib/debugger/test/bs_match_tail_SUITE.erl2
-rw-r--r--lib/debugger/test/bs_utf_SUITE.erl2
-rw-r--r--lib/debugger/test/bug_SUITE.erl2
-rw-r--r--lib/debugger/test/cleanup.erl2
-rw-r--r--lib/debugger/test/dbg_ui_SUITE.erl2
-rw-r--r--lib/debugger/test/debugger_SUITE.erl2
-rw-r--r--lib/debugger/test/erl_eval_SUITE.erl2
-rw-r--r--lib/debugger/test/exception_SUITE.erl2
-rw-r--r--lib/debugger/test/fun_SUITE.erl2
-rw-r--r--lib/debugger/test/guard_SUITE.erl2
-rw-r--r--lib/debugger/test/int_SUITE.erl2
-rw-r--r--lib/debugger/test/int_break_SUITE.erl2
-rw-r--r--lib/debugger/test/int_eval_SUITE.erl2
-rw-r--r--lib/debugger/test/lc_SUITE.erl2
-rw-r--r--lib/debugger/test/line_number_SUITE.erl2
-rw-r--r--lib/debugger/test/map_SUITE.erl22
-rw-r--r--lib/debugger/test/record_SUITE.erl2
-rw-r--r--lib/debugger/test/trycatch_SUITE.erl2
-rw-r--r--lib/dialyzer/doc/src/dialyzer.xml2
-rw-r--r--lib/dialyzer/src/Makefile2
-rw-r--r--lib/dialyzer/src/dialyzer.app.src3
-rw-r--r--lib/dialyzer/src/dialyzer.hrl10
-rw-r--r--lib/dialyzer/src/dialyzer_analysis_callgraph.erl45
-rw-r--r--lib/dialyzer/src/dialyzer_callgraph.erl130
-rw-r--r--lib/dialyzer/src/dialyzer_cl.erl2
-rw-r--r--lib/dialyzer/src/dialyzer_codeserver.erl10
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl23
-rw-r--r--lib/dialyzer/src/dialyzer_coordinator.erl40
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl28
-rw-r--r--lib/dialyzer/src/dialyzer_gui_wx.erl9
-rw-r--r--lib/dialyzer/src/dialyzer_race_data_server.erl134
-rw-r--r--lib/dialyzer/src/dialyzer_races.erl40
-rw-r--r--lib/dialyzer/src/dialyzer_succ_typings.erl3
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl37
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl15
-rw-r--r--lib/dialyzer/src/dialyzer_worker.erl61
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs6
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return2
-rw-r--r--lib/dialyzer/test/dialyzer_SUITE.erl2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/crash10
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/simple6
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl3
-rw-r--r--lib/dialyzer/test/r9c_SUITE_data/results/mnesia4
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/app_call2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/bif13
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes36
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes22
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/literals12
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/maps12
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/record_pat2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/undefined2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl16
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl12
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl6
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl6
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/trec.erl2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/undefined.erl29
-rw-r--r--lib/dialyzer/test/user_SUITE_data/results/wsp_pdu2
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm.erl2
-rw-r--r--lib/diameter/src/base/diameter_service.erl2
-rw-r--r--lib/diameter/src/transport/diameter_sctp.erl12
-rw-r--r--lib/diameter/src/transport/diameter_tcp.erl2
-rw-r--r--lib/edoc/test/Makefile2
-rw-r--r--lib/edoc/test/edoc_SUITE.erl2
-rw-r--r--lib/eldap/src/eldap.erl9
-rw-r--r--lib/eldap/test/eldap_basic_SUITE.erl2
-rw-r--r--lib/erl_docgen/priv/css/otp_doc.css4
-rw-r--r--lib/erl_docgen/test/Makefile2
-rw-r--r--lib/erl_interface/src/Makefile.in63
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE.erl2
-rw-r--r--lib/erl_interface/test/ei_connect_SUITE.erl2
-rw-r--r--lib/erl_interface/test/ei_decode_SUITE.erl2
-rw-r--r--lib/erl_interface/test/ei_decode_encode_SUITE.erl2
-rw-r--r--lib/erl_interface/test/ei_encode_SUITE.erl2
-rw-r--r--lib/erl_interface/test/ei_format_SUITE.erl2
-rw-r--r--lib/erl_interface/test/ei_print_SUITE.erl2
-rw-r--r--lib/erl_interface/test/ei_tmo_SUITE.erl2
-rw-r--r--lib/erl_interface/test/erl_connect_SUITE.erl2
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE.erl2
-rw-r--r--lib/erl_interface/test/erl_ext_SUITE.erl2
-rw-r--r--lib/erl_interface/test/erl_format_SUITE.erl2
-rw-r--r--lib/erl_interface/test/erl_global_SUITE.erl2
-rw-r--r--lib/erl_interface/test/erl_match_SUITE.erl2
-rw-r--r--lib/erl_interface/test/port_call_SUITE.erl2
-rw-r--r--lib/eunit/src/eunit_surefire.erl6
-rw-r--r--lib/eunit/test/Makefile4
-rw-r--r--lib/gs/Makefile2
-rw-r--r--lib/gs/contribs/Makefile32
-rw-r--r--lib/gs/contribs/bonk/Makefile109
-rw-r--r--lib/gs/contribs/bonk/bitmaps/bonkbomb66
-rw-r--r--lib/gs/contribs/bonk/bitmaps/bonkface66
-rw-r--r--lib/gs/contribs/bonk/bitmaps/bonklogo320
-rw-r--r--lib/gs/contribs/bonk/bitmaps/bonkmiss66
-rw-r--r--lib/gs/contribs/bonk/bitmaps/bonktom66
-rw-r--r--lib/gs/contribs/bonk/bitmaps/bonkx66
-rw-r--r--lib/gs/contribs/bonk/bitmaps/erl-e106
-rw-r--r--lib/gs/contribs/bonk/bitmaps/erl-text106
-rw-r--r--lib/gs/contribs/bonk/bonk.erl584
-rw-r--r--lib/gs/contribs/bonk/bonk.gifbin196 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/bonk.tool6
-rw-r--r--lib/gs/contribs/bonk/bonk.txt30
-rw-r--r--lib/gs/contribs/bonk/bonk_sound.erl82
-rw-r--r--lib/gs/contribs/bonk/bonk_square.erl146
-rw-r--r--lib/gs/contribs/bonk/sounder.erl160
-rw-r--r--lib/gs/contribs/bonk/sounds/bonk.aubin2008 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/damn.aubin3744 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/explosion.aubin7708 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/gameover.aubin5986 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/hehee.aubin3772 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/level.aubin5360 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/missedme.aubin2735 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/music.aubin48072 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/ouch!!!.aubin2342 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/praisejesus.aubin16730 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/trumpet.aubin49332 -> 0 bytes
-rw-r--r--lib/gs/contribs/bonk/sounds/yes.aubin4400 -> 0 bytes
-rw-r--r--lib/gs/contribs/cols/Makefile103
-rw-r--r--lib/gs/contribs/cols/cols.erl625
-rw-r--r--lib/gs/contribs/cols/cols.gifbin185 -> 0 bytes
-rw-r--r--lib/gs/contribs/cols/cols.tool5
-rw-r--r--lib/gs/contribs/cols/help.gifbin172 -> 0 bytes
-rw-r--r--lib/gs/contribs/cols/highscore.erl103
-rw-r--r--lib/gs/contribs/mandel/Makefile101
-rw-r--r--lib/gs/contribs/mandel/mandel.erl351
-rw-r--r--lib/gs/contribs/mandel/mandel.gifbin394 -> 0 bytes
-rw-r--r--lib/gs/contribs/mandel/mandel.html74
-rw-r--r--lib/gs/contribs/mandel/mandel.tool6
-rw-r--r--lib/gs/contribs/othello/Makefile101
-rw-r--r--lib/gs/contribs/othello/othello.erl237
-rw-r--r--lib/gs/contribs/othello/othello.gifbin148 -> 0 bytes
-rw-r--r--lib/gs/contribs/othello/othello.tool6
-rw-r--r--lib/gs/contribs/othello/othello_adt.erl540
-rw-r--r--lib/gs/contribs/othello/othello_board.erl649
-rw-r--r--lib/gs/contribs/othello/priv/marker.bm43
-rw-r--r--lib/gs/contribs/othello/priv/square.bm43
-rw-r--r--lib/gs/test/Makefile2
-rw-r--r--lib/hipe/cerl/cerl_cconv.erl13
-rw-r--r--lib/hipe/cerl/cerl_hipeify.erl12
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl94
-rw-r--r--lib/hipe/cerl/erl_types.erl139
-rw-r--r--lib/hipe/flow/cfg.hrl8
-rw-r--r--lib/hipe/icode/hipe_icode.erl42
-rw-r--r--lib/hipe/icode/hipe_icode.hrl3
-rw-r--r--lib/hipe/icode/hipe_icode_exceptions.erl20
-rw-r--r--lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl6
-rw-r--r--lib/hipe/main/hipe.erl5
-rw-r--r--lib/hipe/main/hipe.hrl.src5
-rw-r--r--lib/hipe/main/hipe_main.erl16
-rw-r--r--lib/hipe/test/Makefile2
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_utf.erl2
-rw-r--r--lib/ic/test/Makefile4
-rw-r--r--lib/ic/test/ic_SUITE.erl2
-rw-r--r--lib/ic/test/ic_be_SUITE.erl2
-rw-r--r--lib/ic/test/ic_pp_SUITE.erl2
-rw-r--r--lib/ic/test/ic_pragma_SUITE.erl2
-rw-r--r--lib/ic/test/ic_register_SUITE.erl2
-rw-r--r--lib/ic/test/java_client_erl_server_SUITE.erl2
-rw-r--r--lib/inets/src/tftp/tftp_engine.erl5
-rw-r--r--lib/inets/test/Makefile2
-rw-r--r--lib/inets/test/ftp_format_SUITE.erl1
-rw-r--r--lib/inets/test/ftp_suite_lib.erl4
-rw-r--r--lib/inets/test/httpc_cookie_SUITE.erl2
-rw-r--r--lib/inets/test/httpd_load.erl3
-rw-r--r--lib/inets/test/httpd_mod.erl3
-rw-r--r--lib/inets/test/old_httpd_SUITE.erl3
-rw-r--r--lib/jinterface/test/jinterface_SUITE.erl1
-rw-r--r--lib/jinterface/test/nc_SUITE.erl1
-rw-r--r--lib/kernel/doc/src/code.xml36
-rw-r--r--lib/kernel/doc/src/notes.xml3
-rw-r--r--lib/kernel/doc/src/os.xml25
-rw-r--r--lib/kernel/doc/src/ref_man.xml.src68
-rw-r--r--lib/kernel/include/file.hrl31
-rw-r--r--lib/kernel/src/code.erl121
-rw-r--r--lib/kernel/src/code_server.erl597
-rw-r--r--lib/kernel/src/disk_log.erl68
-rw-r--r--lib/kernel/src/disk_log.hrl6
-rw-r--r--lib/kernel/src/error_logger.erl81
-rw-r--r--lib/kernel/src/erts_debug.erl17
-rw-r--r--lib/kernel/src/global.erl40
-rw-r--r--lib/kernel/src/global_group.erl4
-rw-r--r--lib/kernel/src/inet_config.erl3
-rw-r--r--lib/kernel/src/kernel.erl8
-rw-r--r--lib/kernel/src/os.erl209
-rw-r--r--lib/kernel/test/Makefile2
-rw-r--r--lib/kernel/test/application_SUITE.erl2
-rw-r--r--lib/kernel/test/bif_SUITE.erl2
-rw-r--r--lib/kernel/test/cleanup.erl2
-rw-r--r--lib/kernel/test/code_SUITE.erl217
-rw-r--r--lib/kernel/test/disk_log_SUITE.erl2
-rw-r--r--lib/kernel/test/erl_boot_server_SUITE.erl2
-rw-r--r--lib/kernel/test/erl_distribution_SUITE.erl2
-rw-r--r--lib/kernel/test/erl_distribution_wb_SUITE.erl2
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE.erl182
-rw-r--r--lib/kernel/test/error_logger_SUITE.erl2
-rw-r--r--lib/kernel/test/error_logger_warn_SUITE.erl2
-rw-r--r--lib/kernel/test/file_SUITE.erl24
-rw-r--r--lib/kernel/test/file_name_SUITE.erl8
-rw-r--r--lib/kernel/test/gen_sctp_SUITE.erl2
-rw-r--r--lib/kernel/test/gen_tcp_echo_SUITE.erl11
-rw-r--r--lib/kernel/test/gen_tcp_misc_SUITE.erl18
-rw-r--r--lib/kernel/test/gen_udp_SUITE.erl2
-rw-r--r--lib/kernel/test/global_SUITE.erl6
-rw-r--r--lib/kernel/test/global_group_SUITE.erl2
-rw-r--r--lib/kernel/test/heart_SUITE.erl2
-rw-r--r--lib/kernel/test/ignore_cores.erl2
-rw-r--r--lib/kernel/test/inet_SUITE.erl5
-rw-r--r--lib/kernel/test/inet_res_SUITE.erl3
-rw-r--r--lib/kernel/test/inet_sockopt_SUITE.erl2
-rw-r--r--lib/kernel/test/init_SUITE.erl14
-rw-r--r--lib/kernel/test/interactive_shell_SUITE.erl2
-rw-r--r--lib/kernel/test/kernel_SUITE.erl2
-rw-r--r--lib/kernel/test/kernel_config_SUITE.erl2
-rw-r--r--lib/kernel/test/os_SUITE.erl102
-rw-r--r--lib/kernel/test/pdict_SUITE.erl63
-rw-r--r--lib/kernel/test/pg2_SUITE.erl2
-rw-r--r--lib/kernel/test/prim_file_SUITE.erl14
-rw-r--r--lib/kernel/test/ram_file_SUITE.erl2
-rw-r--r--lib/kernel/test/rpc_SUITE.erl2
-rw-r--r--lib/kernel/test/seq_trace_SUITE.erl2
-rw-r--r--lib/kernel/test/wrap_log_reader_SUITE.erl2
-rw-r--r--lib/kernel/test/zlib_SUITE.erl8
-rw-r--r--lib/megaco/test/Makefile5
-rw-r--r--lib/mnesia/src/mnesia_lib.erl15
-rw-r--r--lib/mnesia/test/mnesia_consistency_test.erl2
-rw-r--r--lib/observer/src/observer_alloc_wx.erl140
-rw-r--r--lib/observer/src/observer_app_wx.erl47
-rw-r--r--lib/observer/src/observer_defs.hrl11
-rw-r--r--lib/observer/src/observer_perf_wx.erl730
-rw-r--r--lib/observer/test/Makefile6
-rw-r--r--lib/observer/test/crashdump_helper.erl2
-rw-r--r--lib/observer/test/crashdump_viewer_SUITE.erl1
-rw-r--r--lib/observer/test/etop_SUITE.erl2
-rw-r--r--lib/observer/test/observer_SUITE.erl2
-rw-r--r--lib/observer/test/ttb_SUITE.erl2
-rw-r--r--lib/odbc/test/Makefile2
-rw-r--r--lib/odbc/test/odbc_connect_SUITE.erl1
-rw-r--r--lib/odbc/test/odbc_data_type_SUITE.erl1
-rw-r--r--lib/odbc/test/odbc_query_SUITE.erl1
-rw-r--r--lib/odbc/test/odbc_start_SUITE.erl1
-rw-r--r--lib/odbc/test/odbc_test_lib.erl2
-rw-r--r--lib/orber/test/Makefile4
-rw-r--r--lib/orber/test/cdrcoding_10_SUITE.erl2
-rw-r--r--lib/orber/test/cdrcoding_11_SUITE.erl2
-rw-r--r--lib/orber/test/cdrcoding_12_SUITE.erl2
-rw-r--r--lib/orber/test/cdrlib_SUITE.erl2
-rw-r--r--lib/orber/test/corba_SUITE.erl2
-rw-r--r--lib/orber/test/csiv2_SUITE.erl2
-rw-r--r--lib/orber/test/data_types_SUITE.erl2
-rw-r--r--lib/orber/test/generated_SUITE.erl2
-rw-r--r--lib/orber/test/interceptors_SUITE.erl2
-rw-r--r--lib/orber/test/iop_ior_10_SUITE.erl2
-rw-r--r--lib/orber/test/iop_ior_11_SUITE.erl2
-rw-r--r--lib/orber/test/iop_ior_12_SUITE.erl2
-rw-r--r--lib/orber/test/ip_v4v6_interop_SUITE.erl2
-rw-r--r--lib/orber/test/lname_SUITE.erl2
-rw-r--r--lib/orber/test/multi_ORB_SUITE.erl2
-rw-r--r--lib/orber/test/naming_context_SUITE.erl2
-rw-r--r--lib/orber/test/orber_SUITE.erl2
-rw-r--r--lib/orber/test/orber_acl_SUITE.erl2
-rw-r--r--lib/orber/test/orber_firewall_ipv4_in_SUITE.erl2
-rw-r--r--lib/orber/test/orber_firewall_ipv4_out_SUITE.erl2
-rw-r--r--lib/orber/test/orber_firewall_ipv6_in_SUITE.erl2
-rw-r--r--lib/orber/test/orber_firewall_ipv6_out_SUITE.erl2
-rw-r--r--lib/orber/test/orber_nat_SUITE.erl2
-rw-r--r--lib/orber/test/orber_test_lib.erl2
-rw-r--r--lib/orber/test/orber_web_SUITE.erl2
-rw-r--r--lib/orber/test/tc_SUITE.erl2
-rw-r--r--lib/os_mon/test/Makefile3
-rw-r--r--lib/os_mon/test/cpu_sup_SUITE.erl2
-rw-r--r--lib/os_mon/test/disksup_SUITE.erl2
-rw-r--r--lib/os_mon/test/memsup_SUITE.erl2
-rw-r--r--lib/os_mon/test/os_mon_SUITE.erl2
-rw-r--r--lib/os_mon/test/os_mon_mib_SUITE.erl2
-rw-r--r--lib/os_mon/test/os_sup_SUITE.erl2
-rw-r--r--lib/ose/Makefile37
-rw-r--r--lib/ose/doc/html/.gitignore0
-rw-r--r--lib/ose/doc/man3/.gitignore0
-rw-r--r--lib/ose/doc/man6/.gitignore0
-rw-r--r--lib/ose/doc/pdf/.gitignore0
-rw-r--r--lib/ose/doc/src/.gitignore1
-rw-r--r--lib/ose/doc/src/Makefile133
-rw-r--r--lib/ose/doc/src/book.xml49
-rw-r--r--lib/ose/doc/src/notes.xml109
-rw-r--r--lib/ose/doc/src/ose_app.xml38
-rw-r--r--lib/ose/doc/src/ose_erl_driver.xml111
-rw-r--r--lib/ose/doc/src/ose_intro.xml154
-rw-r--r--lib/ose/doc/src/ose_signals_chapter.xml240
-rw-r--r--lib/ose/doc/src/part.xml39
-rw-r--r--lib/ose/doc/src/ref_man.xml40
-rw-r--r--lib/ose/ebin/.gitignore0
-rw-r--r--lib/ose/include/.gitignore0
-rw-r--r--lib/ose/info2
-rw-r--r--lib/ose/src/Makefile107
-rw-r--r--lib/ose/src/ose.app.src28
-rw-r--r--lib/ose/src/ose.appup.src23
-rw-r--r--lib/ose/src/ose.erl453
-rw-r--r--lib/ose/test/Makefile67
-rw-r--r--lib/ose/test/ose.cover2
-rw-r--r--lib/ose/test/ose.spec1
-rw-r--r--lib/ose/test/ose_SUITE.erl766
-rw-r--r--lib/ose/vsn.mk1
-rw-r--r--lib/otp_mibs/test/Makefile1
-rw-r--r--lib/otp_mibs/test/otp_mibs_SUITE.erl2
-rw-r--r--lib/parsetools/test/Makefile2
-rw-r--r--lib/parsetools/test/leex_SUITE.erl2
-rw-r--r--lib/parsetools/test/yecc_SUITE.erl2
-rw-r--r--lib/percept/test/Makefile3
-rw-r--r--lib/percept/test/egd_SUITE.erl6
-rw-r--r--lib/percept/test/percept_SUITE.erl2
-rw-r--r--lib/percept/test/percept_db_SUITE.erl2
-rw-r--r--lib/reltool/src/reltool.hrl46
-rw-r--r--lib/reltool/src/reltool_fgraph_win.erl4
-rw-r--r--lib/runtime_tools/c_src/Makefile.in7
-rw-r--r--lib/runtime_tools/doc/src/Makefile2
-rw-r--r--lib/runtime_tools/doc/src/msacc.xml305
-rw-r--r--lib/runtime_tools/doc/src/ref_man.xml1
-rw-r--r--lib/runtime_tools/doc/src/specs.xml1
-rw-r--r--lib/runtime_tools/src/Makefile4
-rw-r--r--lib/runtime_tools/src/msacc.erl355
-rw-r--r--lib/runtime_tools/src/runtime_tools.app.src3
-rw-r--r--lib/runtime_tools/test/Makefile5
-rw-r--r--lib/runtime_tools/test/dbg_SUITE.erl2
-rw-r--r--lib/runtime_tools/test/dyntrace_SUITE.erl2
-rw-r--r--lib/runtime_tools/test/erts_alloc_config_SUITE.erl2
-rw-r--r--lib/runtime_tools/test/msacc_SUITE.erl132
-rw-r--r--lib/runtime_tools/test/runtime_tools_SUITE.erl2
-rw-r--r--lib/sasl/doc/src/Makefile1
-rw-r--r--lib/sasl/doc/src/overload.xml152
-rw-r--r--lib/sasl/doc/src/ref_man.xml1
-rw-r--r--lib/sasl/doc/src/sasl_app.xml17
-rw-r--r--lib/sasl/doc/src/sasl_intro.xml1
-rw-r--r--lib/sasl/src/Makefile2
-rw-r--r--lib/sasl/src/misc_supp.erl2
-rw-r--r--lib/sasl/src/overload.erl233
-rw-r--r--lib/sasl/src/sasl.app.src3
-rw-r--r--lib/sasl/src/sasl.erl5
-rw-r--r--lib/sasl/src/systools_make.erl4
-rw-r--r--lib/sasl/test/Makefile4
-rw-r--r--lib/sasl/test/overload_SUITE.erl168
-rw-r--r--lib/sasl/test/sasl_report_SUITE.erl2
-rw-r--r--lib/sasl/test/systools_SUITE.erl5
-rw-r--r--lib/sasl/test/systools_rc_SUITE.erl4
-rw-r--r--lib/snmp/test/Makefile1
-rw-r--r--lib/snmp/test/exp/snmp_agent_ms_test.erl2
-rw-r--r--lib/snmp/test/exp/snmp_agent_mt_test.erl2
-rw-r--r--lib/snmp/test/exp/snmp_agent_v1_test.erl2
-rw-r--r--lib/snmp/test/exp/snmp_agent_v2_test.erl2
-rw-r--r--lib/snmp/test/exp/snmp_agent_v3_test.erl2
-rw-r--r--lib/snmp/test/snmp_agent_mibs_test.erl2
-rw-r--r--lib/snmp/test/snmp_agent_nfilter_test.erl2
-rw-r--r--lib/snmp/test/snmp_agent_test.erl2
-rw-r--r--lib/snmp/test/snmp_agent_test_lib.erl2
-rw-r--r--lib/snmp/test/snmp_app_test.erl2
-rw-r--r--lib/snmp/test/snmp_compiler_test.erl2
-rw-r--r--lib/snmp/test/snmp_conf_test.erl2
-rw-r--r--lib/snmp/test/snmp_log_test.erl2
-rw-r--r--lib/snmp/test/snmp_manager_config_test.erl2
-rw-r--r--lib/snmp/test/snmp_manager_test.erl2
-rw-r--r--lib/snmp/test/snmp_manager_user.erl2
-rw-r--r--lib/snmp/test/snmp_manager_user_old.erl2
-rw-r--r--lib/snmp/test/snmp_manager_user_test.erl2
-rw-r--r--lib/snmp/test/snmp_manager_user_test_lib.erl2
-rw-r--r--lib/ssh/src/ssh_bits.erl141
-rw-r--r--lib/ssh/src/ssh_connect.hrl5
-rw-r--r--lib/ssh/src/ssh_message.erl169
-rw-r--r--lib/ssh/src/ssh_sftp.erl28
-rw-r--r--lib/ssh/src/ssh_transport.erl48
-rw-r--r--lib/ssh/src/ssh_xfer.erl26
-rw-r--r--lib/ssh/test/Makefile6
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE.erl2
-rw-r--r--lib/ssl/doc/src/ssl_app.xml6
-rw-r--r--lib/ssl/src/ssl_cipher.erl18
-rw-r--r--lib/ssl/src/ssl_connection.hrl23
-rw-r--r--lib/ssl/src/ssl_internal.hrl14
-rw-r--r--lib/ssl/src/ssl_v3.erl4
-rw-r--r--lib/ssl/src/tls_v1.erl4
-rw-r--r--lib/ssl/test/Makefile5
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl40
-rw-r--r--lib/ssl/test/ssl_test_lib.erl4
-rw-r--r--lib/ssl/test/ssl_upgrade_SUITE.erl25
-rw-r--r--lib/stdlib/doc/src/erl_parse.xml120
-rw-r--r--lib/stdlib/doc/src/erl_scan.xml185
-rw-r--r--lib/stdlib/examples/erl_id_trans.erl151
-rw-r--r--lib/stdlib/include/erl_bits.hrl10
-rw-r--r--lib/stdlib/src/beam_lib.erl14
-rw-r--r--lib/stdlib/src/binary.erl77
-rw-r--r--lib/stdlib/src/dets.erl16
-rw-r--r--lib/stdlib/src/epp.erl486
-rw-r--r--lib/stdlib/src/erl_anno.erl96
-rw-r--r--lib/stdlib/src/erl_expand_records.erl36
-rw-r--r--lib/stdlib/src/erl_lint.erl84
-rw-r--r--lib/stdlib/src/erl_parse.yrl500
-rw-r--r--lib/stdlib/src/erl_scan.erl267
-rw-r--r--lib/stdlib/src/escript.erl8
-rw-r--r--lib/stdlib/src/file_sorter.erl22
-rw-r--r--lib/stdlib/src/io.erl45
-rw-r--r--lib/stdlib/src/ms_transform.erl13
-rw-r--r--lib/stdlib/src/otp_internal.erl57
-rw-r--r--lib/stdlib/src/qlc.erl14
-rw-r--r--lib/stdlib/src/qlc_pt.erl40
-rw-r--r--lib/stdlib/src/random.erl1
-rw-r--r--lib/stdlib/src/shell.erl8
-rw-r--r--lib/stdlib/src/slave.erl23
-rw-r--r--lib/stdlib/src/supervisor.erl74
-rw-r--r--lib/stdlib/test/Makefile3
-rw-r--r--lib/stdlib/test/array_SUITE.erl2
-rw-r--r--lib/stdlib/test/base64_SUITE.erl2
-rw-r--r--lib/stdlib/test/beam_lib_SUITE.erl2
-rw-r--r--lib/stdlib/test/binary_module_SUITE.erl42
-rw-r--r--lib/stdlib/test/c_SUITE.erl2
-rw-r--r--lib/stdlib/test/calendar_SUITE.erl2
-rw-r--r--lib/stdlib/test/dets_SUITE.erl70
-rw-r--r--lib/stdlib/test/dict_SUITE.erl18
-rw-r--r--lib/stdlib/test/digraph_SUITE.erl2
-rw-r--r--lib/stdlib/test/digraph_utils_SUITE.erl2
-rw-r--r--lib/stdlib/test/edlin_expand_SUITE.erl2
-rw-r--r--lib/stdlib/test/epp_SUITE.erl185
-rw-r--r--lib/stdlib/test/erl_anno_SUITE.erl76
-rw-r--r--lib/stdlib/test/erl_eval_SUITE.erl2
-rw-r--r--lib/stdlib/test/erl_expand_records_SUITE.erl2
-rw-r--r--lib/stdlib/test/erl_internal_SUITE.erl2
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl97
-rw-r--r--lib/stdlib/test/erl_pp_SUITE.erl19
-rw-r--r--lib/stdlib/test/erl_scan_SUITE.erl281
-rw-r--r--lib/stdlib/test/error_logger_h_SUITE.erl2
-rw-r--r--lib/stdlib/test/escript_SUITE.erl2
-rw-r--r--lib/stdlib/test/ets_SUITE.erl100
-rw-r--r--lib/stdlib/test/ets_tough_SUITE.erl12
-rw-r--r--lib/stdlib/test/file_sorter_SUITE.erl2
-rw-r--r--lib/stdlib/test/filelib_SUITE.erl4
-rw-r--r--lib/stdlib/test/filename_SUITE.erl37
-rw-r--r--lib/stdlib/test/fixtable_SUITE.erl2
-rw-r--r--lib/stdlib/test/format_SUITE.erl2
-rw-r--r--lib/stdlib/test/gen_event_SUITE.erl2
-rw-r--r--lib/stdlib/test/gen_fsm_SUITE.erl2
-rw-r--r--lib/stdlib/test/gen_server_SUITE.erl2
-rw-r--r--lib/stdlib/test/id_transform_SUITE.erl2
-rw-r--r--lib/stdlib/test/io_SUITE.erl2
-rw-r--r--lib/stdlib/test/io_proto_SUITE.erl2
-rw-r--r--lib/stdlib/test/lists_SUITE.erl24
-rw-r--r--lib/stdlib/test/log_mf_h_SUITE.erl2
-rw-r--r--lib/stdlib/test/maps_SUITE.erl2
-rw-r--r--lib/stdlib/test/ms_transform_SUITE.erl8
-rw-r--r--lib/stdlib/test/proc_lib_SUITE.erl2
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl2
-rw-r--r--lib/stdlib/test/queue_SUITE.erl12
-rw-r--r--lib/stdlib/test/rand_SUITE.erl2
-rw-r--r--lib/stdlib/test/random_SUITE.erl2
-rw-r--r--lib/stdlib/test/random_iolist.erl16
-rw-r--r--lib/stdlib/test/random_unicode_list.erl18
-rw-r--r--lib/stdlib/test/re_SUITE.erl2
-rw-r--r--lib/stdlib/test/run_pcre_tests.erl10
-rw-r--r--lib/stdlib/test/select_SUITE.erl23
-rw-r--r--lib/stdlib/test/sets_SUITE.erl24
-rw-r--r--lib/stdlib/test/shell_SUITE.erl6
-rw-r--r--lib/stdlib/test/slave_SUITE.erl2
-rw-r--r--lib/stdlib/test/sofs_SUITE.erl2
-rw-r--r--lib/stdlib/test/stdlib_SUITE.erl2
-rw-r--r--lib/stdlib/test/string_SUITE.erl2
-rw-r--r--lib/stdlib/test/supervisor_bridge_SUITE.erl2
-rw-r--r--lib/stdlib/test/sys_SUITE.erl2
-rw-r--r--lib/stdlib/test/tar_SUITE.erl2
-rw-r--r--lib/stdlib/test/timer_SUITE.erl26
-rw-r--r--lib/stdlib/test/timer_simple_SUITE.erl2
-rw-r--r--lib/stdlib/test/unicode_SUITE.erl2
-rw-r--r--lib/stdlib/test/win32reg_SUITE.erl2
-rw-r--r--lib/stdlib/test/y2k_SUITE.erl2
-rw-r--r--lib/stdlib/test/zip_SUITE.erl3
-rw-r--r--lib/syntax_tools/src/erl_recomment.erl5
-rw-r--r--lib/syntax_tools/src/erl_syntax.erl2
-rw-r--r--lib/syntax_tools/src/erl_syntax_lib.erl12
-rw-r--r--lib/syntax_tools/src/erl_tidy.erl10
-rw-r--r--lib/syntax_tools/src/igor.erl5
-rw-r--r--lib/syntax_tools/src/merl.erl22
-rw-r--r--lib/syntax_tools/src/merl_transform.erl16
-rw-r--r--lib/syntax_tools/test/Makefile2
-rw-r--r--lib/syntax_tools/test/merl_SUITE.erl2
-rw-r--r--lib/syntax_tools/test/syntax_tools_SUITE.erl2
-rw-r--r--lib/test_server/AUTHORS12
-rw-r--r--lib/test_server/Makefile39
-rw-r--r--lib/test_server/README113
-rw-r--r--lib/test_server/doc/html/.gitignore0
-rw-r--r--lib/test_server/doc/man3/.gitignore0
-rw-r--r--lib/test_server/doc/man6/.gitignore0
-rw-r--r--lib/test_server/doc/pdf/.gitignore0
-rw-r--r--lib/test_server/doc/src/Makefile140
-rw-r--r--lib/test_server/doc/src/basics_chapter.xml215
-rw-r--r--lib/test_server/doc/src/book.xml50
-rw-r--r--lib/test_server/doc/src/example_chapter.xml151
-rw-r--r--lib/test_server/doc/src/fascicules.xml18
-rw-r--r--lib/test_server/doc/src/notes.xml1694
-rw-r--r--lib/test_server/doc/src/notes_history.xml113
-rw-r--r--lib/test_server/doc/src/part.xml46
-rw-r--r--lib/test_server/doc/src/part_notes.xml41
-rw-r--r--lib/test_server/doc/src/part_notes_history.xml39
-rw-r--r--lib/test_server/doc/src/ref_man.xml44
-rw-r--r--lib/test_server/doc/src/run_test_chapter.xml50
-rw-r--r--lib/test_server/doc/src/test_server.xml853
-rw-r--r--lib/test_server/doc/src/test_server_app.xml75
-rw-r--r--lib/test_server/doc/src/test_server_ctrl.xml844
-rw-r--r--lib/test_server/doc/src/test_spec_chapter.xml375
-rw-r--r--lib/test_server/doc/src/ts.xml568
-rw-r--r--lib/test_server/doc/src/why_test_chapter.xml141
-rw-r--r--lib/test_server/doc/src/write_framework_chapter.xml160
-rw-r--r--lib/test_server/doc/src/write_test_chapter.xml228
-rw-r--r--lib/test_server/ebin/.gitignore0
-rw-r--r--lib/test_server/include/test_server.hrl32
-rw-r--r--lib/test_server/include/test_server_line.hrl20
-rw-r--r--lib/test_server/info2
-rw-r--r--lib/test_server/prebuild.skip1
-rw-r--r--lib/test_server/src/Makefile144
-rw-r--r--lib/test_server/src/things/distr_startup_SUITE.erl239
-rw-r--r--lib/test_server/src/things/mnesia_power_SUITE.erl126
-rw-r--r--lib/test_server/src/things/random_kill_SUITE.erl82
-rw-r--r--lib/test_server/src/things/soft.gs.txt16
-rw-r--r--lib/test_server/src/things/verify.erl200
-rw-r--r--lib/test_server/test/Makefile92
-rw-r--r--lib/test_server/test/test_server.cover1
-rw-r--r--lib/test_server/test/test_server.spec1
-rw-r--r--lib/test_server/vsn.mk1
-rw-r--r--lib/tools/Makefile2
-rw-r--r--lib/tools/c_src/Makefile.in8
-rw-r--r--lib/tools/doc/src/cover_chapter.xml43
-rw-r--r--lib/tools/emacs/erlang-skels-old.el2
-rw-r--r--lib/tools/emacs/erlang-skels.el2
-rw-r--r--lib/tools/priv/.gitignore (renamed from lib/gs/contribs/ebin/.gitignore)0
-rw-r--r--lib/tools/priv/Makefile69
-rw-r--r--lib/tools/priv/cover.tool2
-rw-r--r--lib/tools/priv/index.html10
-rw-r--r--lib/tools/src/Makefile1
-rw-r--r--lib/tools/src/cover.erl4
-rw-r--r--lib/tools/src/cover_web.erl1185
-rw-r--r--lib/tools/src/lcnt.erl8
-rw-r--r--lib/tools/src/make.erl7
-rw-r--r--lib/tools/src/tools.app.src5
-rw-r--r--lib/tools/test/Makefile3
-rw-r--r--lib/tools/test/cover_SUITE.erl2
-rw-r--r--lib/tools/test/cover_SUITE_data/d.erl2
-rw-r--r--lib/tools/test/cprof_SUITE.erl2
-rw-r--r--lib/tools/test/emem_SUITE.erl2
-rw-r--r--lib/tools/test/eprof_SUITE.erl2
-rw-r--r--lib/tools/test/fprof_SUITE.erl2
-rw-r--r--lib/tools/test/ignore_cores.erl2
-rw-r--r--lib/tools/test/instrument_SUITE.erl2
-rw-r--r--lib/tools/test/lcnt_SUITE.erl2
-rw-r--r--lib/tools/test/make_SUITE.erl2
-rw-r--r--lib/tools/test/tools_SUITE.erl2
-rw-r--r--lib/tools/test/xref_SUITE.erl30
-rw-r--r--lib/typer/src/typer.erl12
-rw-r--r--lib/typer/test/Makefile2
-rw-r--r--lib/webtool/AUTHORS4
-rw-r--r--lib/webtool/Makefile39
-rw-r--r--lib/webtool/doc/html/.gitignore0
-rw-r--r--lib/webtool/doc/man1/.gitignore0
-rw-r--r--lib/webtool/doc/man3/.gitignore0
-rw-r--r--lib/webtool/doc/pdf/.gitignore0
-rw-r--r--lib/webtool/doc/src/Makefile132
-rw-r--r--lib/webtool/doc/src/book.xml48
-rw-r--r--lib/webtool/doc/src/fascicules.xml18
-rw-r--r--lib/webtool/doc/src/notes.xml253
-rw-r--r--lib/webtool/doc/src/notes_history.xml74
-rw-r--r--lib/webtool/doc/src/part.xml38
-rw-r--r--lib/webtool/doc/src/part_notes.xml40
-rw-r--r--lib/webtool/doc/src/part_notes_history.xml40
-rw-r--r--lib/webtool/doc/src/ref_man.xml39
-rw-r--r--lib/webtool/doc/src/start_webtool.xml104
-rw-r--r--lib/webtool/doc/src/webtool.xml157
-rw-r--r--lib/webtool/doc/src/webtool_chapter.xml246
-rw-r--r--lib/webtool/ebin/.gitignore0
-rw-r--r--lib/webtool/info2
-rw-r--r--lib/webtool/priv/Makefile82
-rwxr-xr-xlib/webtool/priv/bin/start_webtool3
-rw-r--r--lib/webtool/priv/bin/start_webtool.bat2
-rw-r--r--lib/webtool/priv/root/conf/mime.types99
-rw-r--r--lib/webtool/priv/root/doc/index.html11
-rw-r--r--lib/webtool/priv/root/doc/start_info.html28
-rw-r--r--lib/webtool/priv/root/doc/tool_management.html9
-rw-r--r--lib/webtool/src/webtool.app.src28
-rw-r--r--lib/webtool/src/webtool.appup.src22
-rw-r--r--lib/webtool/src/webtool.erl1208
-rw-r--r--lib/webtool/src/webtool_sup.erl75
-rw-r--r--lib/webtool/test/Makefile65
-rw-r--r--lib/webtool/test/webtool.spec1
-rw-r--r--lib/webtool/test/webtool_SUITE.erl51
-rw-r--r--lib/webtool/vsn.mk1
-rw-r--r--lib/wx/examples/demo/ex_canvas.erl2
-rw-r--r--lib/wx/examples/sudoku/sudoku_game.erl7
-rw-r--r--lib/xmerl/test/Makefile2
-rw-r--r--lib/xmerl/test/xmerl_SUITE.erl2
-rw-r--r--lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl2
-rw-r--r--lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl2
-rw-r--r--lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl2
-rw-r--r--lib/xmerl/test/xmerl_sax_SUITE.erl2
-rw-r--r--lib/xmerl/test/xmerl_sax_std_SUITE.erl2
-rw-r--r--lib/xmerl/test/xmerl_std_SUITE.erl2
-rw-r--r--lib/xmerl/test/xmerl_test_lib.erl2
-rw-r--r--lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl2
-rw-r--r--lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl2
-rw-r--r--lib/xmerl/test/xmerl_xsd_SUITE.erl2
-rw-r--r--lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl2
-rw-r--r--lib/xmerl/test/xmerl_xsd_lib.erl2
-rw-r--r--make/ose_lm.mk.in76
-rw-r--r--make/otp.mk.in10
-rwxr-xr-xotp_build4
-rw-r--r--system/doc/reference_manual/expressions.xml20
-rw-r--r--system/doc/reference_manual/macros.xml4
-rw-r--r--system/doc/reference_manual/typespec.xml15
-rw-r--r--xcomp/erl-xcomp-powerpc-ose5.conf358
-rw-r--r--xcomp/erl-xcomp-sfk-linux-ose5.conf305
-rw-r--r--xcomp/erl-xcomp-vars.sh2
1355 files changed, 26786 insertions, 51774 deletions
diff --git a/.gitignore b/.gitignore
index e27b5b12ff..3dcfa79f4d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -182,7 +182,6 @@ JAVADOC-GENERATED
# Files generated by configure.
#
-/lib/*/configure
/lib/*/config.log
/lib/*/config.status
@@ -190,6 +189,8 @@ JAVADOC-GENERATED
# Files generated by "./otp_build autoconf"
#
+/lib/*/configure
+/lib/common_test/test_server/configure
/lib/configure.in
/aclocal.m4
/lib/common_test/priv/auxdir/config.guess
@@ -201,9 +202,9 @@ JAVADOC-GENERATED
/lib/erl_interface/src/auxdir/install-sh
/lib/megaco/aclocal.m4
/lib/odbc/aclocal.m4
-/lib/test_server/src/config.guess
-/lib/test_server/src/config.sub
-/lib/test_server/src/install-sh
+/lib/common_test/test_server/config.guess
+/lib/common_test/test_server/config.sub
+/lib/common_test/test_server/install-sh
/lib/wx/aclocal.m4
/lib/wx/autoconf/config.guess
/lib/wx/autoconf/config.sub
diff --git a/HOWTO/INSTALL-CROSS.md b/HOWTO/INSTALL-CROSS.md
index 224f238fd0..0c984a825d 100644
--- a/HOWTO/INSTALL-CROSS.md
+++ b/HOWTO/INSTALL-CROSS.md
@@ -520,29 +520,6 @@ When a variable has been set, no warning will be issued.
`posix_memalign` implementation that accepts larger than page size
alignment.
-* `erl_xcomp_ose_ldflags_pass1` - Linker flags for the OSE module (pass 1)
-
-* `erl_xcomp_ose_ldflags_pass2` - Linker flags for the OSE module (pass 2)
-
-* `erl_xcomp_ose_OSEROOT` - OSE installation root directory
-
-* `erl_xcomp_ose_STRIP` - Strip utility shipped with the OSE distribution
-
-* `erl_xcomp_ose_LM_POST_LINK` - OSE postlink tool
-
-* `erl_xcomp_ose_LM_SET_CONF` - Sets the configuration for an OSE load module
-
-* `erl_xcomp_ose_LM_ELF_SIZE` - Prints the section size information for an
- OSE load module
-
-* `erl_xcomp_ose_LM_LCF` - OSE load module linker configuration file
-
-* `erl_xcomp_ose_BEAM_LM_CONF` - Beam OSE load module configuration file
-
-* `erl_xcomp_ose_EPMD_LM_CONF` - EPMD OSE load module configuration file
-
-* `erl_xcomp_ose_RUN_ERL_LM_CONF` - run_erl_lm OSE load module configuration file
-
Copyright and License
---------------------
diff --git a/Makefile.in b/Makefile.in
index 7ce420a8d7..377eebbbc2 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -670,8 +670,6 @@ tertiary_bootstrap_copy:
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/wx ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/wx ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/ebin ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/ebin ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; fi
- $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server ; fi
- $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server/include ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; fi
$(V_at)for x in lib/ic/ebin/*.beam; do \
@@ -752,17 +750,6 @@ tertiary_bootstrap_copy:
done
# copy test includes to be able to compile tests with bootstrap compiler
- $(V_at)for x in lib/test_server/include/*.hrl; do \
- BN=`basename $$x`; \
- TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/test_server/include/$$BN; \
- test -f $$TF && \
- test '!' -z "`find $$x -newer $$TF -print`" && \
- cp $$x $$TF; \
- test '!' -f $$TF && \
- cp $$x $$TF; \
- true; \
- done
-
$(V_at)for x in lib/common_test/include/*.hrl; do \
BN=`basename $$x`; \
TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include/$$BN; \
@@ -966,7 +953,7 @@ primary_bootstrap_copy:
# To remove modules left by the bootstrap building, but leave (restore)
# the modules in kernel which are needed for an emulator build
-KERNEL_PRELOAD = otp_ring0 init erl_prim_loader prim_inet prim_file zlib prim_zip erlang
+KERNEL_PRELOAD = otp_ring0 init erl_prim_loader prim_inet prim_file zlib prim_zip erlang erts_code_purger
KERNEL_PRELOAD_BEAMS=$(KERNEL_PRELOAD:%=$(BOOTSTRAP_TOP)/lib/kernel/ebin/%.beam)
start_scripts:
@@ -987,7 +974,7 @@ local_setup:
# ---------------------------------------------------------------------
TEST_DIRS := \
- lib/test_server \
+ lib/common_test/test_server \
$(wildcard lib/*/test) \
erts/test \
erts/epmd/test \
diff --git a/OTP_VERSION b/OTP_VERSION
index 93d4fc0a52..cc12e7c6aa 100644
--- a/OTP_VERSION
+++ b/OTP_VERSION
@@ -1 +1,2 @@
-18.2.4
+19.0-rc0
+
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot
index cd628918e0..73381d4d8b 100644
--- a/bootstrap/bin/start.boot
+++ b/bootstrap/bin/start.boot
Binary files differ
diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot
index cd628918e0..73381d4d8b 100644
--- a/bootstrap/bin/start_clean.boot
+++ b/bootstrap/bin/start_clean.boot
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam
index 3ff689bd81..2388ccad80 100644
--- a/bootstrap/lib/compiler/ebin/beam_a.beam
+++ b/bootstrap/lib/compiler/ebin/beam_a.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam
index 6dcce01def..ae57c8dd6b 100644
--- a/bootstrap/lib/compiler/ebin/beam_asm.beam
+++ b/bootstrap/lib/compiler/ebin/beam_asm.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam
index 5d1e45fd72..2854b91bae 100644
--- a/bootstrap/lib/compiler/ebin/beam_block.beam
+++ b/bootstrap/lib/compiler/ebin/beam_block.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam
index 0fa7612114..e677c125a3 100644
--- a/bootstrap/lib/compiler/ebin/beam_bool.beam
+++ b/bootstrap/lib/compiler/ebin/beam_bool.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_bs.beam b/bootstrap/lib/compiler/ebin/beam_bs.beam
new file mode 100644
index 0000000000..18b9f8bc1b
--- /dev/null
+++ b/bootstrap/lib/compiler/ebin/beam_bs.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam
index a6757dfcfb..b65f915978 100644
--- a/bootstrap/lib/compiler/ebin/beam_bsm.beam
+++ b/bootstrap/lib/compiler/ebin/beam_bsm.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam
index 2fd2d2a82f..0f24e040e3 100644
--- a/bootstrap/lib/compiler/ebin/beam_clean.beam
+++ b/bootstrap/lib/compiler/ebin/beam_clean.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam
index 6ae6de1d8b..10926614e6 100644
--- a/bootstrap/lib/compiler/ebin/beam_dead.beam
+++ b/bootstrap/lib/compiler/ebin/beam_dead.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam
index 17b3c40eda..4e12260e65 100644
--- a/bootstrap/lib/compiler/ebin/beam_dict.beam
+++ b/bootstrap/lib/compiler/ebin/beam_dict.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam
index 7c5dca424f..b2fd7faa0c 100644
--- a/bootstrap/lib/compiler/ebin/beam_disasm.beam
+++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam
index f4fccfeef7..e5d2c51c4d 100644
--- a/bootstrap/lib/compiler/ebin/beam_except.beam
+++ b/bootstrap/lib/compiler/ebin/beam_except.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam
index c1d5604349..f6fc8dfc50 100644
--- a/bootstrap/lib/compiler/ebin/beam_flatten.beam
+++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam
index 630a370a94..7382cafb48 100644
--- a/bootstrap/lib/compiler/ebin/beam_jump.beam
+++ b/bootstrap/lib/compiler/ebin/beam_jump.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_listing.beam b/bootstrap/lib/compiler/ebin/beam_listing.beam
index 4d8f94c4ea..41fac49d23 100644
--- a/bootstrap/lib/compiler/ebin/beam_listing.beam
+++ b/bootstrap/lib/compiler/ebin/beam_listing.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam
index 7a7856e247..334047bbf6 100644
--- a/bootstrap/lib/compiler/ebin/beam_peep.beam
+++ b/bootstrap/lib/compiler/ebin/beam_peep.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam
index 78c9eb1c39..0aa196f3de 100644
--- a/bootstrap/lib/compiler/ebin/beam_receive.beam
+++ b/bootstrap/lib/compiler/ebin/beam_receive.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_reorder.beam b/bootstrap/lib/compiler/ebin/beam_reorder.beam
new file mode 100644
index 0000000000..0dc44add6b
--- /dev/null
+++ b/bootstrap/lib/compiler/ebin/beam_reorder.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam
index 4821d92c96..a4e2b78938 100644
--- a/bootstrap/lib/compiler/ebin/beam_split.beam
+++ b/bootstrap/lib/compiler/ebin/beam_split.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam
index 6878a8a01c..194882f68a 100644
--- a/bootstrap/lib/compiler/ebin/beam_trim.beam
+++ b/bootstrap/lib/compiler/ebin/beam_trim.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam
index cb3bc1a8bd..35bc046ef8 100644
--- a/bootstrap/lib/compiler/ebin/beam_type.beam
+++ b/bootstrap/lib/compiler/ebin/beam_type.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam
index fc2e1b6c78..a97fc853a7 100644
--- a/bootstrap/lib/compiler/ebin/beam_utils.beam
+++ b/bootstrap/lib/compiler/ebin/beam_utils.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam
index 8b13cea141..73fa117755 100644
--- a/bootstrap/lib/compiler/ebin/beam_validator.beam
+++ b/bootstrap/lib/compiler/ebin/beam_validator.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam
index ac156a37e9..7bf77d7d33 100644
--- a/bootstrap/lib/compiler/ebin/beam_z.beam
+++ b/bootstrap/lib/compiler/ebin/beam_z.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam
index 758861af20..88857b8905 100644
--- a/bootstrap/lib/compiler/ebin/cerl.beam
+++ b/bootstrap/lib/compiler/ebin/cerl.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_clauses.beam b/bootstrap/lib/compiler/ebin/cerl_clauses.beam
index 2357df79f4..95dd3f3cbb 100644
--- a/bootstrap/lib/compiler/ebin/cerl_clauses.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_clauses.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam
index 0e466ad38e..cc90a53ef9 100644
--- a/bootstrap/lib/compiler/ebin/cerl_inline.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_sets.beam b/bootstrap/lib/compiler/ebin/cerl_sets.beam
index d16543cdbe..20cf324b41 100644
--- a/bootstrap/lib/compiler/ebin/cerl_sets.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_sets.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam
index b23668fb2b..37120929ba 100644
--- a/bootstrap/lib/compiler/ebin/cerl_trees.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam
index 111f85acd2..5234f98a75 100644
--- a/bootstrap/lib/compiler/ebin/compile.beam
+++ b/bootstrap/lib/compiler/ebin/compile.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app
index d3b2296ea4..37a6ce4acb 100644
--- a/bootstrap/lib/compiler/ebin/compiler.app
+++ b/bootstrap/lib/compiler/ebin/compiler.app
@@ -19,12 +19,13 @@
{application, compiler,
[{description, "ERTS CXC 138 10"},
- {vsn, "6.0"},
+ {vsn, "6.0.2"},
{modules, [
beam_a,
beam_asm,
beam_block,
beam_bool,
+ beam_bs,
beam_bsm,
beam_clean,
beam_dead,
@@ -37,6 +38,7 @@
beam_opcodes,
beam_peep,
beam_receive,
+ beam_reorder,
beam_split,
beam_trim,
beam_type,
diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup
index 889b72bd6b..ceb96264d5 100644
--- a/bootstrap/lib/compiler/ebin/compiler.appup
+++ b/bootstrap/lib/compiler/ebin/compiler.appup
@@ -16,7 +16,7 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
-{"5.0.4",
+{"6.0.2",
[{<<".*">>,[{restart_application, compiler}]}],
[{<<".*">>,[{restart_application, compiler}]}]
}.
diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam
index ec87099635..32b770c186 100644
--- a/bootstrap/lib/compiler/ebin/core_lib.beam
+++ b/bootstrap/lib/compiler/ebin/core_lib.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam
index b1cbbf030d..69143cdd23 100644
--- a/bootstrap/lib/compiler/ebin/core_lint.beam
+++ b/bootstrap/lib/compiler/ebin/core_lint.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam
index 025ac1591b..3ef8588f65 100644
--- a/bootstrap/lib/compiler/ebin/core_parse.beam
+++ b/bootstrap/lib/compiler/ebin/core_parse.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam
index 7ba89c698e..f320fd6908 100644
--- a/bootstrap/lib/compiler/ebin/core_pp.beam
+++ b/bootstrap/lib/compiler/ebin/core_pp.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_scan.beam b/bootstrap/lib/compiler/ebin/core_scan.beam
index c54edfc0e7..5f7b22ba8b 100644
--- a/bootstrap/lib/compiler/ebin/core_scan.beam
+++ b/bootstrap/lib/compiler/ebin/core_scan.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam
index c49a2e23e9..9388b5d4e1 100644
--- a/bootstrap/lib/compiler/ebin/rec_env.beam
+++ b/bootstrap/lib/compiler/ebin/rec_env.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam
index 14c69eec6c..0c2d05286a 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam
index cbdef8e1d7..c510dfde01 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam
index 58ae7c0393..20cd2af6bc 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam
index 4f44297bee..963b7ef6e1 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_inline.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_inline.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam
index a1c6466ccd..934a539ad9 100644
--- a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam
+++ b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam
index 6eba755081..71d381b5b3 100644
--- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam
+++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam
index e53f0fcd12..322469639f 100644
--- a/bootstrap/lib/compiler/ebin/v3_codegen.beam
+++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam
index e4c5f51f77..6e6496c7f9 100644
--- a/bootstrap/lib/compiler/ebin/v3_core.beam
+++ b/bootstrap/lib/compiler/ebin/v3_core.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam
index f5cdbb6e40..6555a39c86 100644
--- a/bootstrap/lib/compiler/ebin/v3_kernel.beam
+++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam
index d54716bbee..306ecb1569 100644
--- a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam
+++ b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_life.beam b/bootstrap/lib/compiler/ebin/v3_life.beam
index 741a702e88..d8822f929f 100644
--- a/bootstrap/lib/compiler/ebin/v3_life.beam
+++ b/bootstrap/lib/compiler/ebin/v3_life.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam
index 97c6d9d415..ac01acad27 100644
--- a/bootstrap/lib/kernel/ebin/application.beam
+++ b/bootstrap/lib/kernel/ebin/application.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam
index c4fa46e33e..2b3c8cf454 100644
--- a/bootstrap/lib/kernel/ebin/application_controller.beam
+++ b/bootstrap/lib/kernel/ebin/application_controller.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam
index b81dfa81d3..24492a6771 100644
--- a/bootstrap/lib/kernel/ebin/application_master.beam
+++ b/bootstrap/lib/kernel/ebin/application_master.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application_starter.beam b/bootstrap/lib/kernel/ebin/application_starter.beam
index f5059a487a..043e15fb2a 100644
--- a/bootstrap/lib/kernel/ebin/application_starter.beam
+++ b/bootstrap/lib/kernel/ebin/application_starter.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam
index 74dde4fd1c..cbe477830b 100644
--- a/bootstrap/lib/kernel/ebin/auth.beam
+++ b/bootstrap/lib/kernel/ebin/auth.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam
index cbef1633ee..42f71e7a20 100644
--- a/bootstrap/lib/kernel/ebin/code.beam
+++ b/bootstrap/lib/kernel/ebin/code.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam
index 13ec972cc2..9b250ba708 100644
--- a/bootstrap/lib/kernel/ebin/code_server.beam
+++ b/bootstrap/lib/kernel/ebin/code_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam
index 287a8c0de8..3384baedc0 100644
--- a/bootstrap/lib/kernel/ebin/disk_log.beam
+++ b/bootstrap/lib/kernel/ebin/disk_log.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam
index 55a9365f05..fc1c4781f1 100644
--- a/bootstrap/lib/kernel/ebin/disk_log_1.beam
+++ b/bootstrap/lib/kernel/ebin/disk_log_1.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/disk_log_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam
index 8c1622c7d8..50154045be 100644
--- a/bootstrap/lib/kernel/ebin/disk_log_server.beam
+++ b/bootstrap/lib/kernel/ebin/disk_log_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam
index ea948cfe88..d2c186f03a 100644
--- a/bootstrap/lib/kernel/ebin/dist_ac.beam
+++ b/bootstrap/lib/kernel/ebin/dist_ac.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam
index f87dd4a45c..521bdb5d91 100644
--- a/bootstrap/lib/kernel/ebin/dist_util.beam
+++ b/bootstrap/lib/kernel/ebin/dist_util.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam
index 91899fe231..20c41fd06e 100644
--- a/bootstrap/lib/kernel/ebin/erl_boot_server.beam
+++ b/bootstrap/lib/kernel/ebin/erl_boot_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erl_ddll.beam b/bootstrap/lib/kernel/ebin/erl_ddll.beam
index e15e49d61c..0a644d2e38 100644
--- a/bootstrap/lib/kernel/ebin/erl_ddll.beam
+++ b/bootstrap/lib/kernel/ebin/erl_ddll.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erl_distribution.beam b/bootstrap/lib/kernel/ebin/erl_distribution.beam
index 9a6acc0585..eacacf799c 100644
--- a/bootstrap/lib/kernel/ebin/erl_distribution.beam
+++ b/bootstrap/lib/kernel/ebin/erl_distribution.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam
index 92d6387af3..267958ae88 100644
--- a/bootstrap/lib/kernel/ebin/erl_epmd.beam
+++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erl_reply.beam b/bootstrap/lib/kernel/ebin/erl_reply.beam
index 79fb539bd3..6cf7d9e196 100644
--- a/bootstrap/lib/kernel/ebin/erl_reply.beam
+++ b/bootstrap/lib/kernel/ebin/erl_reply.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/error_handler.beam b/bootstrap/lib/kernel/ebin/error_handler.beam
index 740ba28f72..64f44baeb7 100644
--- a/bootstrap/lib/kernel/ebin/error_handler.beam
+++ b/bootstrap/lib/kernel/ebin/error_handler.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam
index 10f7a0b984..73ab813430 100644
--- a/bootstrap/lib/kernel/ebin/error_logger.beam
+++ b/bootstrap/lib/kernel/ebin/error_logger.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam
index bd73ff6c5c..908c63cb9a 100644
--- a/bootstrap/lib/kernel/ebin/erts_debug.beam
+++ b/bootstrap/lib/kernel/ebin/erts_debug.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam
index 32a3a27993..a66a2621b9 100644
--- a/bootstrap/lib/kernel/ebin/file.beam
+++ b/bootstrap/lib/kernel/ebin/file.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam
index b9c53bde49..dabb6b194e 100644
--- a/bootstrap/lib/kernel/ebin/file_io_server.beam
+++ b/bootstrap/lib/kernel/ebin/file_io_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/file_server.beam b/bootstrap/lib/kernel/ebin/file_server.beam
index 48352e9dfd..151293e05c 100644
--- a/bootstrap/lib/kernel/ebin/file_server.beam
+++ b/bootstrap/lib/kernel/ebin/file_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/gen_sctp.beam b/bootstrap/lib/kernel/ebin/gen_sctp.beam
index e2bb806f2b..91aaa41063 100644
--- a/bootstrap/lib/kernel/ebin/gen_sctp.beam
+++ b/bootstrap/lib/kernel/ebin/gen_sctp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/gen_tcp.beam b/bootstrap/lib/kernel/ebin/gen_tcp.beam
index 0182e11345..e40f1f2e45 100644
--- a/bootstrap/lib/kernel/ebin/gen_tcp.beam
+++ b/bootstrap/lib/kernel/ebin/gen_tcp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/gen_udp.beam b/bootstrap/lib/kernel/ebin/gen_udp.beam
index e49561399d..ec4eda12f7 100644
--- a/bootstrap/lib/kernel/ebin/gen_udp.beam
+++ b/bootstrap/lib/kernel/ebin/gen_udp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam
index 158fbd1c93..419102e285 100644
--- a/bootstrap/lib/kernel/ebin/global.beam
+++ b/bootstrap/lib/kernel/ebin/global.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam
index 85306ef123..1269f7e321 100644
--- a/bootstrap/lib/kernel/ebin/global_group.beam
+++ b/bootstrap/lib/kernel/ebin/global_group.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam
index 0f72880f49..3df8f6030c 100644
--- a/bootstrap/lib/kernel/ebin/group.beam
+++ b/bootstrap/lib/kernel/ebin/group.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam
index d4972ecdd2..480cb0b878 100644
--- a/bootstrap/lib/kernel/ebin/heart.beam
+++ b/bootstrap/lib/kernel/ebin/heart.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam
index 8e2911cd13..3faa4c94ba 100644
--- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam
+++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam
index 75743c63cc..55598b0067 100644
--- a/bootstrap/lib/kernel/ebin/inet.beam
+++ b/bootstrap/lib/kernel/ebin/inet.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet6_sctp.beam b/bootstrap/lib/kernel/ebin/inet6_sctp.beam
index 10c2644259..5c827589bd 100644
--- a/bootstrap/lib/kernel/ebin/inet6_sctp.beam
+++ b/bootstrap/lib/kernel/ebin/inet6_sctp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam
index 96dd4739ea..f1ab2912bb 100644
--- a/bootstrap/lib/kernel/ebin/inet6_tcp.beam
+++ b/bootstrap/lib/kernel/ebin/inet6_tcp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet6_udp.beam b/bootstrap/lib/kernel/ebin/inet6_udp.beam
index 73f0b52b90..2eb8c09701 100644
--- a/bootstrap/lib/kernel/ebin/inet6_udp.beam
+++ b/bootstrap/lib/kernel/ebin/inet6_udp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_config.beam b/bootstrap/lib/kernel/ebin/inet_config.beam
index f31fb16742..f49fa7a376 100644
--- a/bootstrap/lib/kernel/ebin/inet_config.beam
+++ b/bootstrap/lib/kernel/ebin/inet_config.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam
index 6401f0fcfa..1b7450f0d3 100644
--- a/bootstrap/lib/kernel/ebin/inet_db.beam
+++ b/bootstrap/lib/kernel/ebin/inet_db.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam
index b1c3bf3369..88ecaaf10b 100644
--- a/bootstrap/lib/kernel/ebin/inet_dns.beam
+++ b/bootstrap/lib/kernel/ebin/inet_dns.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam
index 098c397936..93f60428a1 100644
--- a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam
+++ b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_hosts.beam b/bootstrap/lib/kernel/ebin/inet_hosts.beam
index 3e70a8b8c1..7278913418 100644
--- a/bootstrap/lib/kernel/ebin/inet_hosts.beam
+++ b/bootstrap/lib/kernel/ebin/inet_hosts.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam
index 294afcea30..4323d12bf1 100644
--- a/bootstrap/lib/kernel/ebin/inet_parse.beam
+++ b/bootstrap/lib/kernel/ebin/inet_parse.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam
index f35242f49a..ada7300673 100644
--- a/bootstrap/lib/kernel/ebin/inet_res.beam
+++ b/bootstrap/lib/kernel/ebin/inet_res.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_sctp.beam b/bootstrap/lib/kernel/ebin/inet_sctp.beam
index 19506c14e9..835c7b2928 100644
--- a/bootstrap/lib/kernel/ebin/inet_sctp.beam
+++ b/bootstrap/lib/kernel/ebin/inet_sctp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_tcp.beam b/bootstrap/lib/kernel/ebin/inet_tcp.beam
index c2b42fef1c..698a94770b 100644
--- a/bootstrap/lib/kernel/ebin/inet_tcp.beam
+++ b/bootstrap/lib/kernel/ebin/inet_tcp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam
index 1b389cbb4d..59cb7ce40e 100644
--- a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam
+++ b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_udp.beam b/bootstrap/lib/kernel/ebin/inet_udp.beam
index 6fbdd29f6d..6876ba3892 100644
--- a/bootstrap/lib/kernel/ebin/inet_udp.beam
+++ b/bootstrap/lib/kernel/ebin/inet_udp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app
index 85ba41bcef..14f526c30c 100644
--- a/bootstrap/lib/kernel/ebin/kernel.app
+++ b/bootstrap/lib/kernel/ebin/kernel.app
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -22,7 +22,7 @@
{application, kernel,
[
{description, "ERTS CXC 138 10"},
- {vsn, "4.0"},
+ {vsn, "4.1.1"},
{modules, [application,
application_controller,
application_master,
@@ -116,6 +116,6 @@
{applications, []},
{env, [{error_logger, tty}]},
{mod, {kernel, []}},
- {runtime_dependencies, ["erts-7.0", "stdlib-2.5", "sasl-2.4"]}
+ {runtime_dependencies, ["erts-7.3", "stdlib-2.6", "sasl-2.6"]}
]
}.
diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup
index d09e0c6347..5cd6724383 100644
--- a/bootstrap/lib/kernel/ebin/kernel.appup
+++ b/bootstrap/lib/kernel/ebin/kernel.appup
@@ -16,9 +16,11 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
-{"4.0",
+{"4.1.1",
%% Up from - max one major revision back
- [{<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17
+ [{<<"4\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.*
+ {<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17
%% Down to - max one major revision back
- [{<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17
+ [{<<"4\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.*
+ {<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17
}.
diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam
index caeda89fa5..9fd407c287 100644
--- a/bootstrap/lib/kernel/ebin/kernel.beam
+++ b/bootstrap/lib/kernel/ebin/kernel.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam
index 5a4649a054..8691aff64a 100644
--- a/bootstrap/lib/kernel/ebin/kernel_config.beam
+++ b/bootstrap/lib/kernel/ebin/kernel_config.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam
index 4b09aae8a5..00772b61ff 100644
--- a/bootstrap/lib/kernel/ebin/net_adm.beam
+++ b/bootstrap/lib/kernel/ebin/net_adm.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam
index e0bb445bf5..bd15759017 100644
--- a/bootstrap/lib/kernel/ebin/net_kernel.beam
+++ b/bootstrap/lib/kernel/ebin/net_kernel.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam
index 9eaf7dfe5d..9ebe6c770f 100644
--- a/bootstrap/lib/kernel/ebin/os.beam
+++ b/bootstrap/lib/kernel/ebin/os.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam
index 944f6a27a4..2115e46b60 100644
--- a/bootstrap/lib/kernel/ebin/pg2.beam
+++ b/bootstrap/lib/kernel/ebin/pg2.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/ram_file.beam b/bootstrap/lib/kernel/ebin/ram_file.beam
index a8b23f5490..b119b3656c 100644
--- a/bootstrap/lib/kernel/ebin/ram_file.beam
+++ b/bootstrap/lib/kernel/ebin/ram_file.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam
index 4a8aa5da69..4d1cbdb625 100644
--- a/bootstrap/lib/kernel/ebin/rpc.beam
+++ b/bootstrap/lib/kernel/ebin/rpc.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/seq_trace.beam b/bootstrap/lib/kernel/ebin/seq_trace.beam
index 13489135a2..68d1b50f84 100644
--- a/bootstrap/lib/kernel/ebin/seq_trace.beam
+++ b/bootstrap/lib/kernel/ebin/seq_trace.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam
index be4f9292e7..9dfd66b2f4 100644
--- a/bootstrap/lib/kernel/ebin/standard_error.beam
+++ b/bootstrap/lib/kernel/ebin/standard_error.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam
index d69339866a..c2b2808555 100644
--- a/bootstrap/lib/kernel/ebin/user.beam
+++ b/bootstrap/lib/kernel/ebin/user.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam
index 726a130b55..e306b172bf 100644
--- a/bootstrap/lib/kernel/ebin/user_drv.beam
+++ b/bootstrap/lib/kernel/ebin/user_drv.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/user_sup.beam b/bootstrap/lib/kernel/ebin/user_sup.beam
index 79dd095896..9e7b95544d 100644
--- a/bootstrap/lib/kernel/ebin/user_sup.beam
+++ b/bootstrap/lib/kernel/ebin/user_sup.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam
index 68578800a0..91ef523b99 100644
--- a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam
+++ b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/include/file.hrl b/bootstrap/lib/kernel/include/file.hrl
index 7cf033f7f5..36112bb040 100644
--- a/bootstrap/lib/kernel/include/file.hrl
+++ b/bootstrap/lib/kernel/include/file.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,37 +23,40 @@
%%--------------------------------------------------------------------------
-record(file_info,
- {size :: non_neg_integer(), % Size of file in bytes.
- type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink',
- access :: 'read' | 'write' | 'read_write' | 'none',
- atime :: file:date_time() | non_neg_integer(),
+ {size :: non_neg_integer() | 'undefined', % Size of file in bytes.
+ type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink'
+ | 'undefined',
+ access :: 'read' | 'write' | 'read_write' | 'none' | 'undefined',
+ atime :: file:date_time() | non_neg_integer() | 'undefined',
% The local time the file was last read:
% {{Year, Mon, Day}, {Hour, Min, Sec}}.
% atime, ctime, mtime may also be unix epochs()
- mtime :: file:date_time() | non_neg_integer(),
+ mtime :: file:date_time() | non_neg_integer() | 'undefined',
% The local time the file was last written.
- ctime :: file:date_time() | non_neg_integer(),
+ ctime :: file:date_time() | non_neg_integer() | 'undefined',
% The interpretation of this time field
% is dependent on operating system.
% On Unix it is the last time the file
% or the inode was changed. On Windows,
% it is the creation time.
- mode :: non_neg_integer(), % File permissions. On Windows,
+ mode :: non_neg_integer() | 'undefined',
+ % File permissions. On Windows,
% the owner permissions will be
% duplicated for group and user.
- links :: non_neg_integer(),
+ links :: non_neg_integer() | 'undefined',
% Number of links to the file (1 if the
% filesystem doesn't support links).
- major_device :: non_neg_integer(),
+ major_device :: non_neg_integer() | 'undefined',
% Identifies the file system (Unix),
% or the drive number (A: = 0, B: = 1)
% (Windows).
%% The following are Unix specific.
%% They are set to zero on other operating systems.
- minor_device :: non_neg_integer(), % Only valid for devices.
- inode :: non_neg_integer(), % Inode number for file.
- uid :: non_neg_integer(), % User id for owner.
- gid :: non_neg_integer()}). % Group id for owner.
+ minor_device :: non_neg_integer() | 'undefined',
+ % Only valid for devices.
+ inode :: non_neg_integer() | 'undefined', % Inode number for file.
+ uid :: non_neg_integer() | 'undefined', % User id for owner.
+ gid :: non_neg_integer() | 'undefined'}). % Group id for owner.
-record(file_descriptor,
diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam
index 4ad9c7cd04..4ad8942b06 100644
--- a/bootstrap/lib/stdlib/ebin/array.beam
+++ b/bootstrap/lib/stdlib/ebin/array.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/base64.beam b/bootstrap/lib/stdlib/ebin/base64.beam
index e8d4b44102..ad725f61b9 100644
--- a/bootstrap/lib/stdlib/ebin/base64.beam
+++ b/bootstrap/lib/stdlib/ebin/base64.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam
index d4f06cf9fd..4caf4f6455 100644
--- a/bootstrap/lib/stdlib/ebin/beam_lib.beam
+++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/binary.beam b/bootstrap/lib/stdlib/ebin/binary.beam
index 666544c492..538d169565 100644
--- a/bootstrap/lib/stdlib/ebin/binary.beam
+++ b/bootstrap/lib/stdlib/ebin/binary.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam
index 0e07dc1531..133035102e 100644
--- a/bootstrap/lib/stdlib/ebin/c.beam
+++ b/bootstrap/lib/stdlib/ebin/c.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/calendar.beam b/bootstrap/lib/stdlib/ebin/calendar.beam
index 383d66e1a8..e71eebae3f 100644
--- a/bootstrap/lib/stdlib/ebin/calendar.beam
+++ b/bootstrap/lib/stdlib/ebin/calendar.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam
index 100996bf85..b255a4e10f 100644
--- a/bootstrap/lib/stdlib/ebin/dets.beam
+++ b/bootstrap/lib/stdlib/ebin/dets.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dets_server.beam b/bootstrap/lib/stdlib/ebin/dets_server.beam
index 46c6769dfe..da999f3025 100644
--- a/bootstrap/lib/stdlib/ebin/dets_server.beam
+++ b/bootstrap/lib/stdlib/ebin/dets_server.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam
index f2d1d86a60..ab627d50df 100644
--- a/bootstrap/lib/stdlib/ebin/dets_utils.beam
+++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dets_v8.beam b/bootstrap/lib/stdlib/ebin/dets_v8.beam
index eca5a85114..9a1416a316 100644
--- a/bootstrap/lib/stdlib/ebin/dets_v8.beam
+++ b/bootstrap/lib/stdlib/ebin/dets_v8.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam
index 711ca0b9f0..0b966769ba 100644
--- a/bootstrap/lib/stdlib/ebin/dets_v9.beam
+++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam
index 6ba808d6af..3b2b5a4c04 100644
--- a/bootstrap/lib/stdlib/ebin/dict.beam
+++ b/bootstrap/lib/stdlib/ebin/dict.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/digraph.beam b/bootstrap/lib/stdlib/ebin/digraph.beam
index 40db38c992..76713562bc 100644
--- a/bootstrap/lib/stdlib/ebin/digraph.beam
+++ b/bootstrap/lib/stdlib/ebin/digraph.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/digraph_utils.beam b/bootstrap/lib/stdlib/ebin/digraph_utils.beam
index 458c6d2895..9065fda936 100644
--- a/bootstrap/lib/stdlib/ebin/digraph_utils.beam
+++ b/bootstrap/lib/stdlib/ebin/digraph_utils.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam
index aaa080bd97..8b1719eb0a 100644
--- a/bootstrap/lib/stdlib/ebin/edlin.beam
+++ b/bootstrap/lib/stdlib/ebin/edlin.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/edlin_expand.beam b/bootstrap/lib/stdlib/ebin/edlin_expand.beam
index 3d9846bdcf..adc0f4ba1c 100644
--- a/bootstrap/lib/stdlib/ebin/edlin_expand.beam
+++ b/bootstrap/lib/stdlib/ebin/edlin_expand.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam
index 00cf6f2a5c..d19b427124 100644
--- a/bootstrap/lib/stdlib/ebin/epp.beam
+++ b/bootstrap/lib/stdlib/ebin/epp.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam
index 4807dac5f9..72a255c88f 100644
--- a/bootstrap/lib/stdlib/ebin/erl_anno.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_anno.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_bits.beam b/bootstrap/lib/stdlib/ebin/erl_bits.beam
index 627b9ca711..af8619bac0 100644
--- a/bootstrap/lib/stdlib/ebin/erl_bits.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_bits.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam
index e650afbf6d..82949da20a 100644
--- a/bootstrap/lib/stdlib/ebin/erl_compile.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_compile.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam
index 2354a065ca..b58781d3f8 100644
--- a/bootstrap/lib/stdlib/ebin/erl_eval.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam
index db2d0e6b85..617913c674 100644
--- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam
index 35482f799b..3a0681d1bf 100644
--- a/bootstrap/lib/stdlib/ebin/erl_lint.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam
index 4b0e853390..f00eef7500 100644
--- a/bootstrap/lib/stdlib/ebin/erl_parse.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam
index d40913093a..4cc4884c92 100644
--- a/bootstrap/lib/stdlib/ebin/erl_pp.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam
index c29200f2e0..6c35d20c46 100644
--- a/bootstrap/lib/stdlib/ebin/erl_scan.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam
index e525b3738b..9bcbabc27c 100644
--- a/bootstrap/lib/stdlib/ebin/erl_tar.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam
index 0b98a9ceed..0e61e87708 100644
--- a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam
+++ b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam
index 565904b903..46eafce18e 100644
--- a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam
+++ b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam
index e923cecea8..c006d9a1ad 100644
--- a/bootstrap/lib/stdlib/ebin/escript.beam
+++ b/bootstrap/lib/stdlib/ebin/escript.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam
index 9ac333dbee..a15534b365 100644
--- a/bootstrap/lib/stdlib/ebin/ets.beam
+++ b/bootstrap/lib/stdlib/ebin/ets.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam
index 6627e1132c..be20e8c720 100644
--- a/bootstrap/lib/stdlib/ebin/eval_bits.beam
+++ b/bootstrap/lib/stdlib/ebin/eval_bits.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam
index a2a82fb77d..9286aea119 100644
--- a/bootstrap/lib/stdlib/ebin/file_sorter.beam
+++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam
index 5941f9189f..5ea27fdca6 100644
--- a/bootstrap/lib/stdlib/ebin/filelib.beam
+++ b/bootstrap/lib/stdlib/ebin/filelib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam
index e4b462f5ff..f1252b1e7e 100644
--- a/bootstrap/lib/stdlib/ebin/filename.beam
+++ b/bootstrap/lib/stdlib/ebin/filename.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gb_sets.beam b/bootstrap/lib/stdlib/ebin/gb_sets.beam
index 71da2376ba..3cb606350b 100644
--- a/bootstrap/lib/stdlib/ebin/gb_sets.beam
+++ b/bootstrap/lib/stdlib/ebin/gb_sets.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gb_trees.beam b/bootstrap/lib/stdlib/ebin/gb_trees.beam
index db59d5af19..d8579c63cd 100644
--- a/bootstrap/lib/stdlib/ebin/gb_trees.beam
+++ b/bootstrap/lib/stdlib/ebin/gb_trees.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam
index ccaabd8087..586973a973 100644
--- a/bootstrap/lib/stdlib/ebin/gen.beam
+++ b/bootstrap/lib/stdlib/ebin/gen.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam
index d22f9ec402..4788735049 100644
--- a/bootstrap/lib/stdlib/ebin/gen_event.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_event.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam
index 119c20e1d7..f78a7368d5 100644
--- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam
index d6e5d223fb..8ebe9d7a3a 100644
--- a/bootstrap/lib/stdlib/ebin/gen_server.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_server.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam
index fd64aedde1..283c912800 100644
--- a/bootstrap/lib/stdlib/ebin/io.beam
+++ b/bootstrap/lib/stdlib/ebin/io.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam
index c95a88c0f0..c52bf42077 100644
--- a/bootstrap/lib/stdlib/ebin/io_lib.beam
+++ b/bootstrap/lib/stdlib/ebin/io_lib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam
index 032e15eeb1..3fdf08d9e4 100644
--- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam
+++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam
index b4af88d5b5..62a4beeb2d 100644
--- a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam
+++ b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam
index eed02e5fa5..9d37b74ad3 100644
--- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam
+++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/lib.beam b/bootstrap/lib/stdlib/ebin/lib.beam
index 1cc92d1b8d..8e594d97ad 100644
--- a/bootstrap/lib/stdlib/ebin/lib.beam
+++ b/bootstrap/lib/stdlib/ebin/lib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam
index 9db37e21d4..91297311b2 100644
--- a/bootstrap/lib/stdlib/ebin/lists.beam
+++ b/bootstrap/lib/stdlib/ebin/lists.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/log_mf_h.beam b/bootstrap/lib/stdlib/ebin/log_mf_h.beam
index 58a8d68ed5..0c4b22c3df 100644
--- a/bootstrap/lib/stdlib/ebin/log_mf_h.beam
+++ b/bootstrap/lib/stdlib/ebin/log_mf_h.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam
index d1aa8bb9dd..d616a902ae 100644
--- a/bootstrap/lib/stdlib/ebin/maps.beam
+++ b/bootstrap/lib/stdlib/ebin/maps.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam
index cc8503fdb3..2c0eb8a742 100644
--- a/bootstrap/lib/stdlib/ebin/ms_transform.beam
+++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/orddict.beam b/bootstrap/lib/stdlib/ebin/orddict.beam
index 665941a17c..f04348f982 100644
--- a/bootstrap/lib/stdlib/ebin/orddict.beam
+++ b/bootstrap/lib/stdlib/ebin/orddict.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam
index 9e63d204b6..3e3673577a 100644
--- a/bootstrap/lib/stdlib/ebin/otp_internal.beam
+++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam
index 72934a42d7..a06ae1717a 100644
--- a/bootstrap/lib/stdlib/ebin/pool.beam
+++ b/bootstrap/lib/stdlib/ebin/pool.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam
index 0f732c8cae..568015b3e4 100644
--- a/bootstrap/lib/stdlib/ebin/proc_lib.beam
+++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/proplists.beam b/bootstrap/lib/stdlib/ebin/proplists.beam
index 2640cfe4ae..835df8c3a0 100644
--- a/bootstrap/lib/stdlib/ebin/proplists.beam
+++ b/bootstrap/lib/stdlib/ebin/proplists.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam
index 652604afc0..436b62e50e 100644
--- a/bootstrap/lib/stdlib/ebin/qlc.beam
+++ b/bootstrap/lib/stdlib/ebin/qlc.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam
index 90bc537b85..4032af0dd7 100644
--- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam
+++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam
index 6abb189f16..8370469ff4 100644
--- a/bootstrap/lib/stdlib/ebin/rand.beam
+++ b/bootstrap/lib/stdlib/ebin/rand.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/random.beam b/bootstrap/lib/stdlib/ebin/random.beam
index f576b310df..fc351a800a 100644
--- a/bootstrap/lib/stdlib/ebin/random.beam
+++ b/bootstrap/lib/stdlib/ebin/random.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam
index 875c4a5513..7b2e736a21 100644
--- a/bootstrap/lib/stdlib/ebin/re.beam
+++ b/bootstrap/lib/stdlib/ebin/re.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/sets.beam b/bootstrap/lib/stdlib/ebin/sets.beam
index d8546de28d..4d4a2205f9 100644
--- a/bootstrap/lib/stdlib/ebin/sets.beam
+++ b/bootstrap/lib/stdlib/ebin/sets.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam
index 9ad6d68ebd..8e64036c90 100644
--- a/bootstrap/lib/stdlib/ebin/shell.beam
+++ b/bootstrap/lib/stdlib/ebin/shell.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam
index 532c46cd38..373d65f198 100644
--- a/bootstrap/lib/stdlib/ebin/slave.beam
+++ b/bootstrap/lib/stdlib/ebin/slave.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam
index 976483833f..5514b0d4f9 100644
--- a/bootstrap/lib/stdlib/ebin/sofs.beam
+++ b/bootstrap/lib/stdlib/ebin/sofs.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app
index 4a52c6a443..7287cbd451 100644
--- a/bootstrap/lib/stdlib/ebin/stdlib.app
+++ b/bootstrap/lib/stdlib/ebin/stdlib.app
@@ -20,7 +20,7 @@
%%
{application, stdlib,
[{description, "ERTS CXC 138 10"},
- {vsn, "2.5"},
+ {vsn, "2.7"},
{modules, [array,
base64,
beam_lib,
@@ -105,7 +105,7 @@
dets]},
{applications, [kernel]},
{env, []},
- {runtime_dependencies, ["sasl-2.4","kernel-4.0","erts-7.0","crypto-3.3",
+ {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.3","crypto-3.3",
"compiler-5.0"]}
]}.
diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup
index 689485f421..8b0206f6be 100644
--- a/bootstrap/lib/stdlib/ebin/stdlib.appup
+++ b/bootstrap/lib/stdlib/ebin/stdlib.appup
@@ -16,9 +16,11 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
-{"2.5",
+{"2.7",
%% Up from - max one major revision back
- [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0-17.5
+ [{<<"2\\.[5-7](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.*
+ {<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}], % 17.0-17.5
%% Down to - max one major revision back
- [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0-17.5
+ [{<<"2\\.[5-7](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.*
+ {<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}] % 17.0-17.5
}.
diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam
index ce7b63a6c2..e03a3264a6 100644
--- a/bootstrap/lib/stdlib/ebin/supervisor.beam
+++ b/bootstrap/lib/stdlib/ebin/supervisor.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam
index 4af6cc8f40..d2bfe6eea8 100644
--- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam
+++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam
index a569f8003f..d0162bdd07 100644
--- a/bootstrap/lib/stdlib/ebin/sys.beam
+++ b/bootstrap/lib/stdlib/ebin/sys.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/timer.beam b/bootstrap/lib/stdlib/ebin/timer.beam
index 9887f37c70..8d8fcf8937 100644
--- a/bootstrap/lib/stdlib/ebin/timer.beam
+++ b/bootstrap/lib/stdlib/ebin/timer.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam
index 16557d5631..17a318c4d4 100644
--- a/bootstrap/lib/stdlib/ebin/unicode.beam
+++ b/bootstrap/lib/stdlib/ebin/unicode.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/win32reg.beam b/bootstrap/lib/stdlib/ebin/win32reg.beam
index b37ead63ba..2b4f9229ea 100644
--- a/bootstrap/lib/stdlib/ebin/win32reg.beam
+++ b/bootstrap/lib/stdlib/ebin/win32reg.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam
index 83407cdb87..1a19b1f28a 100644
--- a/bootstrap/lib/stdlib/ebin/zip.beam
+++ b/bootstrap/lib/stdlib/ebin/zip.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/include/erl_bits.hrl b/bootstrap/lib/stdlib/include/erl_bits.hrl
index 8405a55d55..2a54587a17 100644
--- a/bootstrap/lib/stdlib/include/erl_bits.hrl
+++ b/bootstrap/lib/stdlib/include/erl_bits.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-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.
@@ -26,10 +26,10 @@
-type bt_unit() :: 1..256.
-record(bittype, {
- type :: bt_type(),
- unit :: bt_unit(), %% element unit
- sign :: bt_sign(),
- endian :: bt_endian()
+ type :: bt_type() | 'undefined',
+ unit :: bt_unit() | 'undefined', %% element unit
+ sign :: bt_sign() | 'undefined',
+ endian :: bt_endian() | 'undefined'
}).
-record(bitdefault, {
diff --git a/configure.in b/configure.in
index 40498f2ff9..89486590b8 100644
--- a/configure.in
+++ b/configure.in
@@ -208,10 +208,6 @@ AS_HELP_STRING([--disable-threads], [disable async thread support]))
AC_ARG_ENABLE(dirty-schedulers,
AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]))
-AC_ARG_ENABLE(halfword-emulator,
-AS_HELP_STRING([--enable-halfword-emulator],
- [enable halfword emulator (only for 64bit builds). Note: Halfword emulator is marked as deprecated and scheduled for removal in future major release.]))
-
AC_ARG_ENABLE(smp-support,
AS_HELP_STRING([--enable-smp-support], [enable smp support])
AS_HELP_STRING([--disable-smp-support], [disable smp support]))
@@ -282,6 +278,10 @@ AC_ARG_ENABLE(builtin-zlib,
AS_HELP_STRING([--enable-builtin-zlib],
[force use of our own built-in zlib]))
+AC_ARG_ENABLE(sharing-preserving,
+AS_HELP_STRING([--enable-sharing-preserving],
+ [enable copying of terms without destroying sharing]))
+
dnl This functionality has been lost along the way... :(
dnl It could perhaps be nice to reintroduce some day; therefore,
dnl it is not removed just commented out.
diff --git a/erts/aclocal.m4 b/erts/aclocal.m4
index ec9b66bf29..017fdbd589 100644
--- a/erts/aclocal.m4
+++ b/erts/aclocal.m4
@@ -74,21 +74,6 @@ AC_ARG_VAR(erl_xcomp_clock_gettime_cpu_time, [clock_gettime() can be used for re
AC_ARG_VAR(erl_xcomp_after_morecore_hook, [__after_morecore_hook can track malloc()s core memory usage: yes|no (only used when cross compiling)])
AC_ARG_VAR(erl_xcomp_dlsym_brk_wrappers, [dlsym(RTLD_NEXT, _) brk wrappers can track malloc()s core memory usage: yes|no (only used when cross compiling)])
-dnl Cross compilation variables for OSE
-AC_ARG_VAR(erl_xcomp_ose_ldflags_pass1, [Linker flags for the OSE module (pass 1) (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_ldflags_pass2, [Linker flags for the OSE module (pass 2) (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_OSEROOT, [OSE installation root directory (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_STRIP, [Strip utility shipped with the OSE distribution(only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_LM_POST_LINK, [OSE postlink tool (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_LM_SET_CONF, [Sets the configuration for an OSE load module (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_LM_ELF_SIZE, [Prints the section size information for an OSE load module (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_LM_LCF, [OSE load module linker configuration file (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_BEAM_LM_CONF, [BEAM OSE load module default configuration file (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_EPMD_LM_CONF, [EPMD OSE load module default configuration file (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_RUN_ERL_LM_CONF, [run_erl_lm OSE load module default configuration file (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_CONFD, [OSE confd source file])
-AC_ARG_VAR(erl_xcomp_ose_CRT0_LM, [OSE crt0 lm source file])
-
])
AC_DEFUN(ERL_XCOMP_SYSROOT_INIT,
@@ -503,8 +488,6 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support,
#ifdef __WIN32__
#include <winsock2.h>
#include <ws2tcpip.h>
-#elif __OSE__
-#error "no ipv6"
#else
#include <netinet/in.h>
#endif],
@@ -517,8 +500,6 @@ else
#ifdef __WIN32__
#include <winsock2.h>
#include <ws2tcpip.h>
-#elif __OSE__
-#error "no ipv6"
#else
#include <netinet/in.h>
#endif],
@@ -991,12 +972,6 @@ if test "X$host_os" = "Xwin32"; then
THR_LIBS=
THR_LIB_NAME=win32_threads
THR_LIB_TYPE=win32_threads
-elif test "X$host_os" = "Xose"; then
- AC_MSG_RESULT(yes)
- THR_DEFS="-DOSE_THREADS"
- THR_LIBS=
- THR_LIB_NAME=ose_threads
- THR_LIB_TYPE=ose_threads
else
AC_MSG_RESULT(no)
THR_DEFS=
@@ -1583,22 +1558,9 @@ case "$THR_LIB_NAME" in
fi
;;
- pthread|ose_threads)
- case "$THR_LIB_NAME" in
- pthread)
- ETHR_THR_LIB_BASE_DIR=pthread
- AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads])
- ;;
- ose_threads)
- AC_DEFINE(ETHR_OSE_THREADS, 1,
- [Define if you have OSE style threads])
- ETHR_THR_LIB_BASE_DIR=ose
- AC_CHECK_HEADER(ose_spi/ose_spi.h,
- AC_DEFINE(HAVE_OSE_SPI_H, 1,
- [Define if you have the "ose_spi/ose_spi.h" header file.]))
- ;;
- esac
- if test "x$THR_LIB_NAME" = "xpthread"; then
+ pthread)
+ ETHR_THR_LIB_BASE_DIR=pthread
+ AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads])
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1657,7 +1619,6 @@ case "$THR_LIB_NAME" in
*) ;;
esac
- fi
dnl We sometimes need ETHR_DEFS in order to find certain headers
dnl (at least for pthread.h on osf1).
saved_cppflags="$CPPFLAGS"
@@ -1702,7 +1663,6 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
@@ -1922,8 +1882,6 @@ case "$THR_LIB_NAME" in
esac
CFLAGS=$old_CFLAGS
- fi ## test "x$THR_LIB_NAME" = "xpthread"
-
if test "X$disable_native_ethr_impls" = "Xyes"; then
ethr_have_native_atomics=no
else
diff --git a/erts/configure.in b/erts/configure.in
index c7b095d47a..ba735fe921 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -106,7 +106,6 @@ AC_CONFIG_HEADER($host/config.h:config.h.in include/internal/$host/ethread_heade
dnl ----------------------------------------------------------------------
dnl Optional features.
dnl ----------------------------------------------------------------------
-enable_child_waiter_thread=no
ENABLE_ALLOC_TYPE_VARS=
AC_SUBST(ENABLE_ALLOC_TYPE_VARS)
@@ -143,14 +142,6 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]),
*) enable_dirty_schedulers=yes ;;
esac ], enable_dirty_schedulers=no)
-AC_ARG_ENABLE(halfword-emulator,
-AS_HELP_STRING([--enable-halfword-emulator],
- [enable halfword emulator (only for 64bit builds). Note: Halfword emulator is marked as deprecated and scheduled for removal in future major release.]),
-[ case "$enableval" in
- no) enable_halfword_emualtor=no ;;
- *) enable_halfword_emulator=yes ;;
- esac ], enable_halfword_emulator=unknown)
-
AC_ARG_ENABLE(smp-support,
AS_HELP_STRING([--enable-smp-support], [enable smp support])
AS_HELP_STRING([--disable-smp-support], [disable smp support]),
@@ -351,6 +342,21 @@ AS_HELP_STRING([--disable-saved-compile-time], [disable saved compile time]),
AC_DEFINE_UNQUOTED(ERTS_SAVED_COMPILE_TIME, $save_compile_time, [Save compile time?])
+AC_ARG_WITH(microstate-accounting,
+AS_HELP_STRING([--with-microstate-accounting={yes|extra}],
+ [enable microstate account, possibly with extra detailed states])
+AS_HELP_STRING([--without-microstate-accounting],
+ [don't enable microstate accounting]),
+[],[with_microstate_accounting=yes])
+
+case "$with_microstate_accounting" in
+ yes) AC_DEFINE(ERTS_ENABLE_MSACC,[1],
+ [Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;;
+ extra) AC_DEFINE(ERTS_ENABLE_MSACC,[2],
+ [Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;;
+ *) ;;
+esac
+
dnl Magic test for clearcase.
OTP_RELEASE=
if test "${ERLANG_COMMERCIAL_BUILD}" != ""; then
@@ -796,36 +802,18 @@ esac
AC_SUBST(LIBCARBON)
-dnl Check if we should/can build a halfword emulator
-
-AC_MSG_CHECKING(if we are building a halfword emulator (32bit heap on 64bit machine))
-if test "$enable_halfword_emulator" = "yes"; then
- if test "$ARCH" = "amd64"; then
- AC_DEFINE(HALFWORD_HEAP_EMULATOR, [1],
- [Define if building a halfword-heap 64bit emulator])
- ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS halfword"
- AC_MSG_RESULT([yes])
-
- test -f "$ERL_TOP/erts/CONF_INFO" ||
- echo "" > "$ERL_TOP/erts/CONF_INFO"
- cat >> $ERL_TOP/erts/CONF_INFO <<EOF
-
- The HALFWORD emulator has been enabled.
- This is a DEPRECATED feature scheduled for removal
- in a future major release.
+dnl Check if we should/can build a sharing-preserving emulator
-EOF
- else
- AC_MSG_ERROR(no; halfword emulator not supported on this architecture)
- fi
+AC_MSG_CHECKING(if we are building a sharing-preserving emulator)
+if test "$enable_sharing_preserving" = "yes"; then
+ AC_DEFINE(SHCOPY, [1],
+ [Define if building a sharing-preserving emulator])
+ AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
fi
-
-
-
dnl some tests below will call this if we haven't already - and autoconf
dnl can't handle those tests being done conditionally at runtime
AC_PROG_CPP
@@ -944,10 +932,7 @@ dnl what the user say. This might not be the right way to do it, but
dnl for now that is the way we do it.
USER_LD=$LD
USER_LDFLAGS="$LDFLAGS"
-case $host in
- *ose) ;;
- *) LD='$(CC)' ;;
-esac
+LD='$(CC)'
AC_SUBST(LD)
LDFLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH"
@@ -962,8 +947,6 @@ dnl This is the os flavour, should be unix, ose, vxworks or win32
case $host in
win32)
ERLANG_OSTYPE=win32 ;;
- *ose)
- ERLANG_OSTYPE=ose ;;
*)
ERLANG_OSTYPE=unix ;;
esac
@@ -1272,7 +1255,7 @@ case "$enable_threads"-"$found_threads" in
AC_MSG_RESULT(yes; enabled by user) ;;
unknown-yes)
case $host_os in
- solaris*|linux*|darwin*|win32|ose)
+ solaris*|linux*|darwin*|win32)
emu_threads=yes
AC_MSG_RESULT(yes; default on this platform)
;;
@@ -1334,11 +1317,7 @@ else
AC_MSG_RESULT(no)
fi
- disable_child_waiter_thread=no
case $host_os in
- solaris*)
- enable_child_waiter_thread=yes
- ;;
linux*)
AC_MSG_CHECKING([whether dlopen() needs to be called before first call to dlerror()])
if test "x$ETHR_THR_LIB_BASE_TYPE" != "xposix_nptl"; then
@@ -1348,16 +1327,6 @@ else
else
AC_MSG_RESULT(no)
fi
- if test "x$ETHR_THR_LIB_BASE_TYPE" != "xposix_nptl"; then
- # Child waiter thread cannot be enabled
- disable_child_waiter_thread=yes
- enable_child_waiter_thread=no
- fi
- ;;
- win32|ose)
- # Child waiter thread cannot be enabled
- disable_child_waiter_thread=yes
- enable_child_waiter_thread=no
;;
*)
;;
@@ -1377,24 +1346,6 @@ else
esac
done
EMU_THR_DEFS=$new_emu_thr_defs
-
- AC_MSG_CHECKING(whether the child waiter thread should be enabled)
- if test $enable_child_waiter_thread = yes; then
- AC_DEFINE(ENABLE_CHILD_WAITER_THREAD,[1],
- [Define if you want to enable child waiter thread])
- AC_MSG_RESULT(yes)
- else
- case $ERTS_BUILD_SMP_EMU-$disable_child_waiter_thread in
- yes-no)
- AC_MSG_RESULT([yes on SMP build, but not on non-SMP build]);;
- *-yes)
- AC_DEFINE(DISABLE_CHILD_WAITER_THREAD,[1],
- [Define if you want to disable child waiter thread])
- AC_MSG_RESULT(no);;
- *)
- AC_MSG_RESULT(no);;
- esac
- fi
fi
AC_SUBST(EMU_THR_LIB_NAME)
@@ -1526,19 +1477,27 @@ dnl
# if -lsocket doesn't work by itself.
#--------------------------------------------------------------------
+tk_oldLibs=$LIBS
erl_checkBoth=0
+SOCKET_LIBS=""
AC_CHECK_FUNC(connect, erl_checkSocket=0, erl_checkSocket=1)
if test "$erl_checkSocket" = 1; then
- AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", erl_checkBoth=1)
+ AC_CHECK_LIB(socket, main, SOCKET_LIBS="-lsocket", erl_checkBoth=1)
fi
+
if test "$erl_checkBoth" = 1; then
- tk_oldLibs=$LIBS
LIBS="$LIBS -lsocket -lnsl"
- AC_CHECK_FUNC(accept, erl_checkNsl=0, [LIBS=$tk_oldLibs])
+ AC_CHECK_FUNC(accept, SOCKET_LIBS="-lsocket -lnsl")
fi
-AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"]))
+
+LIBS="$tk_oldLibs $SOCKET_LIBS"
+AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [SOCKET_LIBS="$SOCKET_LIBS -lnsl"]))
AC_CHECK_FUNC(gethostbyname_r,have_gethostbyname_r=yes)
+LIBS="$tk_oldLibs $SOCKET_LIBS"
+
+AC_SUBST(SOCKET_LIBS)
+
dnl
dnl These gethostbyname thingies use old style AC_DEFINE for BC with ancient
dnl autoconf...
@@ -2118,7 +2077,7 @@ AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2])
AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \
pread pwrite memmove strerror strerror_r strncasecmp \
gethrtime localtime_r gmtime_r inet_pton \
- memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \
+ mmap mremap memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \
flockfile fstat strlcpy strlcat setsid posix2time time2posix \
setlocale nl_langinfo poll mlockall ppoll])
@@ -2136,8 +2095,7 @@ fi
case X$erl_xcomp_posix_memalign in
Xno) ;;
- Xyes) AC_DEFINE(HAVE_POSIX_MEMALIGN,[1],
- [Define to 1 if you have the `posix_memalign' function.]) ;;
+ Xyes) have_posix_memalign=yes ;;
*)
AC_CHECK_FUNC(
[posix_memalign],
@@ -2152,15 +2110,19 @@ int main(void) {
return error;
return 0;
}
-],AC_DEFINE(HAVE_POSIX_MEMALIGN,[1],
- [Define to 1 if you have the `posix_memalign' function.])
+],have_posix_memalign=yes
)
else
- AC_DEFINE(HAVE_POSIX_MEMALIGN,[1],
- [Define to 1 if you have the `posix_memalign' function.])
+ have_posix_memalign=yes
fi]);;
esac
+if test $have_posix_memalign = yes; then
+ AC_DEFINE(HAVE_POSIX_MEMALIGN,[1],
+ [Define to 1 if you have the `posix_memalign' function.])
+fi
+
+
dnl writev on OS X snow leopard is broken for files > 4GB
case $host_os in
darwin10.8.0)
@@ -2170,17 +2132,6 @@ case $host_os in
AC_CHECK_FUNCS([writev]) ;;
esac
-case $host_os in
- *ose)
- AC_MSG_CHECKING([for mmap])
- AC_MSG_RESULT(not using for OSE)
- AC_MSG_CHECKING([for mremap])
- AC_MSG_RESULT(not using for OSE) ;;
- *)
- AC_CHECK_FUNCS([mmap mremap]) ;;
-esac
-
-
AC_CHECK_DECLS([posix2time, time2posix],,,[#include <time.h>])
disable_vfork=false
@@ -2829,17 +2780,26 @@ LM_SYS_IPV6
LM_SYS_MULTICAST
ERL_TIME_CORRECTION
AC_CHECK_PROG(M4, m4, m4)
+
+
+dnl HiPE cannot run on 64-bit without MAP_FIXED and MAP_NORESERVE
+if test X${enable_hipe} != Xno && test X$ac_cv_sizeof_void_p != X4; then
+ AC_CHECK_DECLS([MAP_FIXED, MAP_NORESERVE], [], [], [#include <sys/mman.h>])
+ if test X$ac_cv_have_decl_MAP_FIXED != Xyes || test X$ac_cv_have_decl_MAP_NORESERVE != Xyes; then
+ if test X${enable_hipe} = Xyes; then
+ AC_MSG_ERROR([HiPE on 64-bit needs MAP_FIXED and MAP_NORESERVE flags for mmap()])
+ else
+ enable_hipe=no
+ AC_MSG_WARN([Disable HiPE due to lack of MAP_FIXED and MAP_NORESERVE flags for mmap()])
+ fi
+ fi
+fi
+
dnl check to auto-enable hipe here...
if test "$cross_compiling" != "yes" && test X${enable_hipe} != Xno; then
if test -z "$M4"; then
enable_hipe=no
AC_MSG_NOTICE([HiPE disabled as no valid m4 is found in PATH])
- elif test "$enable_halfword_emulator" = "yes"; then
- if test X${enable_hipe} = Xyes; then
- AC_MSG_ERROR([HiPE can not be combined with halfword emulator (yet)])
- else
- AC_MSG_NOTICE([HiPE auto-disabled on halfword emulator])
- fi
else
case "$ARCH-$OPSYS" in
x86-linux|amd64-linux|x86-darwin*|amd64-darwin*|ppc-linux|ppc64-linux|ppc-darwin|arm-linux|amd64-freebsd|x86-freebsd|x86-sol2|amd64-sol2|ultrasparc-linux)
@@ -3768,7 +3728,7 @@ dnl crypto
#
#--------------------------------------------------------------------
-DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE"
+DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE -I${ERL_TOP}/erts/emulator/sys/common"
if test "X$ETHR_DEFS" = "X"; then
DED_THR_DEFS="-D_THREAD_SAFE -D_REENTRANT"
@@ -4940,7 +4900,6 @@ AC_OUTPUT(
Makefile:Makefile.in
../make/$host/otp.mk:../make/otp.mk.in
../make/$host/otp_ded.mk:../make/otp_ded.mk.in
- ../make/$host/ose_lm.mk:../make/ose_lm.mk.in
dnl
dnl The ones below should be moved to their respective lib
dnl
diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml
index 186c9a1143..ccdecf44ec 100644
--- a/erts/doc/src/absform.xml
+++ b/erts/doc/src/absform.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2001</year><year>2015</year>
+ <year>2001</year><year>2016</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -68,31 +68,29 @@
<item>If D is a module declaration consisting of the forms
<c>F_1</c>, ..., <c>F_k</c>, then
Rep(D) = <c>[Rep(F_1), ..., Rep(F_k)]</c>.</item>
- <item>If F is an attribute <c>-module(Mod)</c>, then
- Rep(F) = <c>{attribute,LINE,module,Mod}</c>.</item>
<item>If F is an attribute <c>-behavior(Behavior)</c>, then
Rep(F) = <c>{attribute,LINE,behavior,Behavior}</c>.</item>
<item>If F is an attribute <c>-behaviour(Behaviour)</c>, then
Rep(F) = <c>{attribute,LINE,behaviour,Behaviour}</c>.</item>
+ <item>If F is an attribute <c>-compile(Options)</c>, then
+ Rep(F) = <c>{attribute,LINE,compile,Options}</c>.</item>
<item>If F is an attribute <c>-export([Fun_1/A_1, ..., Fun_k/A_k])</c>, then
Rep(F) = <c>{attribute,LINE,export,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}</c>.</item>
- <item>If F is an attribute <c>-import(Mod,[Fun_1/A_1, ..., Fun_k/A_k])</c>, then
- Rep(F) = <c>{attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}</c>.</item>
<item>If F is an attribute <c>-export_type([Type_1/A_1, ..., Type_k/A_k])</c>, then
Rep(F) = <c>{attribute,LINE,export_type,[{Type_1,A_1}, ..., {Type_k,A_k}]}</c>.</item>
- <item>If F is an attribute <c>-compile(Options)</c>, then
- Rep(F) = <c>{attribute,LINE,compile,Options}</c>.</item>
+ <item>If F is an attribute <c>-import(Mod,[Fun_1/A_1, ..., Fun_k/A_k])</c>, then
+ Rep(F) = <c>{attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}</c>.</item>
+ <item>If F is an attribute <c>-module(Mod)</c>, then
+ Rep(F) = <c>{attribute,LINE,module,Mod}</c>.</item>
+ <item>If F is an attribute <c>-optional_callbacks([Fun_1/A_1, ..., Fun_k/A_k])</c>, then
+ Rep(F) = <c>{attribute,LINE,optional_callbacks,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}</c>.</item>
<item>If F is an attribute <c>-file(File,Line)</c>, then
Rep(F) = <c>{attribute,LINE,file,{File,Line}}</c>.</item>
- <item>If F is a record declaration
- <c>-record(Name,{V_1, ..., V_k})</c>, then Rep(F) =
- <c>{attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}</c>.
- For Rep(V), see below.</item>
- <item>If F is a type declaration
- <c>-Type Name(V_1, ..., V_k) :: T</c>, where
- <c>Type</c> is either the atom <c>type</c> or the atom <c>opaque</c>,
- each <c>V_i</c> is a variable, and <c>T</c> is a type, then Rep(F) =
- <c>{attribute,LINE,Type,{Name,Rep(T),[Rep(V_1), ..., Rep(V_k)]}}</c>.
+ <item>If F is a function declaration
+ <c>Name Fc_1 ; ... ; Name Fc_k</c>,
+ where each <c>Fc_i</c> is a function clause with a
+ pattern sequence of the same length <c>Arity</c>, then
+ Rep(F) = <c>{function,LINE,Name,Arity,[Rep(Fc_1), ...,Rep(Fc_k)]}</c>.
</item>
<item>If F is a function specification
<c>-Spec Name Ft_1; ...; Ft_k</c>,
@@ -109,15 +107,20 @@
<c>Arity</c>, then Rep(F) =
<c>{attribute,Line,spec,{{Mod,Name,Arity},[Rep(Ft_1), ..., Rep(Ft_k)]}}</c>.
</item>
+ <item>If F is a record declaration
+ <c>-record(Name,{V_1, ..., V_k})</c>,
+ where each <c>V_i</c> is a record field, then Rep(F) =
+ <c>{attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}</c>.
+ For Rep(V), see below.</item>
+ <item>If F is a type declaration
+ <c>-Type Name(V_1, ..., V_k) :: T</c>, where
+ <c>Type</c> is either the atom <c>type</c> or the atom <c>opaque</c>,
+ each <c>V_i</c> is a variable, and <c>T</c> is a type, then Rep(F) =
+ <c>{attribute,LINE,Type,{Name,Rep(T),[Rep(V_1), ..., Rep(V_k)]}}</c>.
+ </item>
<item>If F is a wild attribute <c>-A(T)</c>, then
Rep(F) = <c>{attribute,LINE,A,T}</c>.
<br></br></item>
- <item>If F is a function declaration
- <c>Name Fc_1 ; ... ; Name Fc_k</c>,
- where each <c>Fc_i</c> is a function clause with a
- pattern sequence of the same length <c>Arity</c>, then
- Rep(F) = <c>{function,LINE,Name,Arity,[Rep(Fc_1), ...,Rep(Fc_k)]}</c>.
- </item>
</list>
<section>
@@ -131,11 +134,6 @@
<item>If V is <c>A = E</c>,
where <c>E</c> is an expression, then
Rep(V) = <c>{record_field,LINE,Rep(A),Rep(E)}</c>.</item>
- <item>If V is <c>A :: T</c>, where <c>T</c> is a
- type and it does not contain
- <c>undefined</c> syntactically, then Rep(V) =
- <c>{typed_record_field,{record_field,LINE,Rep(A)},Rep(undefined | T)}</c>.
- </item>
<item>If V is <c>A :: T</c>, where <c>T</c> is a type, then Rep(V) =
<c>{typed_record_field,{record_field,LINE,Rep(A)},Rep(T)}</c>.
</item>
@@ -162,15 +160,15 @@
<p>There are five kinds of atomic literals, which are represented in the
same way in patterns, expressions and guards:</p>
<list type="bulleted">
- <item>If L is an integer or character literal, then
- Rep(L) = <c>{integer,LINE,L}</c>.</item>
+ <item>If L is an atom literal, then
+ Rep(L) = <c>{atom,LINE,L}</c>.</item>
<item>If L is a float literal, then
Rep(L) = <c>{float,LINE,L}</c>.</item>
+ <item>If L is an integer or character literal, then
+ Rep(L) = <c>{integer,LINE,L}</c>.</item>
<item>If L is a string literal consisting of the characters
<c>C_1</c>, ..., <c>C_k</c>, then
Rep(L) = <c>{string,LINE,[C_1, ..., C_k]}</c>.</item>
- <item>If L is an atom literal, then
- Rep(L) = <c>{atom,LINE,L}</c>.</item>
</list>
<p>Note that negative integer and float literals do not occur as such; they are
parsed as an application of the unary negation operator.</p>
@@ -178,47 +176,59 @@
<section>
<title>Patterns</title>
- <p>If <c>Ps</c> is a sequence of patterns <c>P_1, ..., P_k</c>, then
+ <p>If Ps is a sequence of patterns <c>P_1, ..., P_k</c>, then
Rep(Ps) = <c>[Rep(P_1), ..., Rep(P_k)]</c>. Such sequences occur as the
list of arguments to a function or fun.</p>
<p>Individual patterns are represented as follows:</p>
<list type="bulleted">
- <item>If P is an atomic literal L, then Rep(P) = Rep(L).</item>
+ <item>If P is an atomic literal <c>L</c>, then Rep(P) = Rep(L).</item>
+ <item>If P is a binary pattern
+ <c>&lt;&lt;P_1:Size_1/TSL_1, ..., P_k:Size_k/TSL_k>></c>, where each
+ <c>Size_i</c> is an expression that can be evaluated to an integer
+ and each <c>TSL_i</c> is a type specificer list, then
+ Rep(P) = <c>{bin,LINE,[{bin_element,LINE,Rep(P_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(P_k),Rep(Size_k),Rep(TSL_k)}]}</c>.
+ For Rep(TSL), see below.
+ An omitted <c>Size_i</c> is represented by <c>default</c>.
+ An omitted <c>TSL_i</c> is represented by <c>default</c>.</item>
<item>If P is a compound pattern <c>P_1 = P_2</c>, then
Rep(P) = <c>{match,LINE,Rep(P_1),Rep(P_2)}</c>.</item>
- <item>If P is a variable pattern <c>V</c>, then
- Rep(P) = <c>{var,LINE,A}</c>,
- where A is an atom with a printname consisting of the same characters as
- <c>V</c>.</item>
- <item>If P is a universal pattern <c>_</c>, then
- Rep(P) = <c>{var,LINE,'_'}</c>.</item>
- <item>If P is a tuple pattern <c>{P_1, ..., P_k}</c>, then
- Rep(P) = <c>{tuple,LINE,[Rep(P_1), ..., Rep(P_k)]}</c>.</item>
- <item>If P is a nil pattern <c>[]</c>, then
- Rep(P) = <c>{nil,LINE}</c>.</item>
<item>If P is a cons pattern <c>[P_h | P_t]</c>, then
Rep(P) = <c>{cons,LINE,Rep(P_h),Rep(P_t)}</c>.</item>
- <item>If E is a binary pattern <c>&lt;&lt;P_1:Size_1/TSL_1, ..., P_k:Size_k/TSL_k>></c>, then
- Rep(E) = <c>{bin,LINE,[{bin_element,LINE,Rep(P_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(P_k),Rep(Size_k),Rep(TSL_k)}]}</c>.
- For Rep(TSL), see below.
- An omitted <c>Size</c> is represented by <c>default</c>. An omitted <c>TSL</c>
- (type specifier list) is represented by <c>default</c>.</item>
- <item>If P is <c>P_1 Op P_2</c>, where <c>Op</c> is a binary operator (this
- is either an occurrence of <c>++</c> applied to a literal string or character
+ <item>If P is a map pattern <c>#{A_1, ..., A_k}</c>, where each
+ <c>A_i</c> is an association <c>P_i_1 := P_i_2</c>, then Rep(P) =
+ <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see
+ below.</item>
+ <item>If P is a nil pattern <c>[]</c>, then
+ Rep(P) = <c>{nil,LINE}</c>.</item>
+ <item>If P is an operator pattern <c>P_1 Op P_2</c>,
+ where <c>Op</c> is a binary operator (this is either an occurrence
+ of <c>++</c> applied to a literal string or character
list, or an occurrence of an expression that can be evaluated to a number
at compile time),
then Rep(P) = <c>{op,LINE,Op,Rep(P_1),Rep(P_2)}</c>.</item>
- <item>If P is <c>Op P_0</c>, where <c>Op</c> is a unary operator (this is an
- occurrence of an expression that can be evaluated to a number at compile
+ <item>If P is an operator pattern <c>Op P_0</c>,
+ where <c>Op</c> is a unary operator (this is an occurrence of
+ an expression that can be evaluated to a number at compile
time), then Rep(P) = <c>{op,LINE,Op,Rep(P_0)}</c>.</item>
- <item>If P is a record pattern <c>#Name{Field_1=P_1, ..., Field_k=P_k}</c>,
- then Rep(P) =
- <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(P_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(P_k)}]}</c>.</item>
- <item>If P is <c>#Name.Field</c>, then
- Rep(P) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item>
- <item>If P is <c>( P_0 )</c>, then
+ <item>If P is a parenthesized pattern <c>( P_0 )</c>, then
Rep(P) = <c>Rep(P_0)</c>,
- that is, patterns cannot be distinguished from their bodies.</item>
+ that is, parenthesized patterns cannot be distinguished from their
+ bodies.</item>
+ <item>If P is a record field index pattern <c>#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(P) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item>
+ <item>If P is a record pattern
+ <c>#Name{Field_1=P_1, ..., Field_k=P_k}</c>,
+ where each <c>Field_i</c> is an atom or <c>_</c>, then Rep(P) =
+ <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(P_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(P_k)}]}</c>.</item>
+ <item>If P is a tuple pattern <c>{P_1, ..., P_k}</c>, then
+ Rep(P) = <c>{tuple,LINE,[Rep(P_1), ..., Rep(P_k)]}</c>.</item>
+ <item>If P is a universal pattern <c>_</c>, then
+ Rep(P) = <c>{var,LINE,'_'}</c>.</item>
+ <item>If P is a variable pattern <c>V</c>, then
+ Rep(P) = <c>{var,LINE,A}</c>,
+ where A is an atom with a printname consisting of the same characters as
+ <c>V</c>.</item>
</list>
<p>Note that every pattern has the same source form as some expression, and is
represented the same way as the corresponding expression.</p>
@@ -226,167 +236,185 @@
<section>
<title>Expressions</title>
- <p>A body B is a sequence of expressions <c>E_1, ..., E_k</c>, and
- Rep(B) = <c>[Rep(E_1), ..., Rep(E_k)]</c>.</p>
+ <p>A body B is a nonempty sequence of expressions <c>E_1, ..., E_k</c>,
+ and Rep(B) = <c>[Rep(E_1), ..., Rep(E_k)]</c>.</p>
<p>An expression E is one of the following alternatives:</p>
<list type="bulleted">
- <item>If P is an atomic literal <c>L</c>, then Rep(P) = Rep(L).</item>
- <item>If E is <c>P = E_0</c>, then
- Rep(E) = <c>{match,LINE,Rep(P),Rep(E_0)}</c>.</item>
- <item>If E is a variable <c>V</c>, then Rep(E) = <c>{var,LINE,A}</c>,
- where <c>A</c> is an atom with a printname consisting of the same
- characters as <c>V</c>.</item>
- <item>If E is a tuple skeleton <c>{E_1, ..., E_k}</c>, then
- Rep(E) = <c>{tuple,LINE,[Rep(E_1), ..., Rep(E_k)]}</c>.</item>
- <item>If E is <c>[]</c>, then
- Rep(E) = <c>{nil,LINE}</c>.</item>
- <item>If E is a cons skeleton <c>[E_h | E_t]</c>, then
- Rep(E) = <c>{cons,LINE,Rep(E_h),Rep(E_t)}</c>.</item>
- <item>If E is a binary constructor <c>&lt;&lt;V_1:Size_1/TSL_1, ..., V_k:Size_k/TSL_k>></c>, then Rep(E) =
- <c>{bin,LINE,[{bin_element,LINE,Rep(V_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(V_k),Rep(Size_k),Rep(TSL_k)}]}</c>.
+ <item>If E is an atomic literal <c>L</c>, then Rep(E) = Rep(L).</item>
+ <item>If E is a binary comprehension
+ <c>&lt;&lt;E_0 || Q_1, ..., Q_k>></c>,
+ where each <c>Q_i</c> is a qualifier, then
+ Rep(E) = <c>{bc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}</c>.
+ For Rep(Q), see below.</item>
+ <item>If E is a binary constructor <c>&lt;&lt;E_1:Size_1/TSL_1, ..., E_k:Size_k/TSL_k>></c>,
+ where each <c>Size_i</c> is an expression and each
+ <c>TSL_i</c> is a type specificer list, then Rep(E) =
+ <c>{bin,LINE,[{bin_element,LINE,Rep(E_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(E_k),Rep(Size_k),Rep(TSL_k)}]}</c>.
For Rep(TSL), see below.
- An omitted <c>Size</c> is represented by <c>default</c>. An omitted <c>TSL</c>
- (type specifier list) is represented by <c>default</c>.</item>
- <item>If E is <c>E_1 Op E_2</c>, where <c>Op</c> is a binary operator,
- then Rep(E) = <c>{op,LINE,Op,Rep(E_1),Rep(E_2)}</c>.</item>
- <item>If E is <c>Op E_0</c>, where <c>Op</c> is a unary operator, then
- Rep(E) = <c>{op,LINE,Op,Rep(E_0)}</c>.</item>
- <item>If E is <c>#Name{Field_1=E_1, ..., Field_k=E_k}</c>,
- then Rep(E) =
- <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item>
- <item>If E is <c>E_0#Name{Field_1=E_1, ..., Field_k=E_k}</c>, then
- Rep(E) =
- <c>{record,LINE,Rep(E_0),Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item>
- <item>If E is <c>#Name.Field</c>, then
- Rep(E) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item>
- <item>If E is <c>E_0#Name.Field</c>, then
- Rep(E) = <c>{record_field,LINE,Rep(E_0),Name,Rep(Field)}</c>.</item>
- <item>If E is <c>#{W_1, ..., W_k}</c> where each
- <c>W_i</c> is a map assoc or exact field, then Rep(E) =
- <c>{map,LINE,[Rep(W_1), ..., Rep(W_k)]}</c>. For Rep(W), see
- below.</item>
- <item>If E is <c>E_0#{W_1, ..., W_k}</c> where
- <c>W_i</c> is a map assoc or exact field, then Rep(E) =
- <c>{map,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}</c>.
- For Rep(W), see below.</item>
- <item>If E is <c>catch E_0</c>, then
+ An omitted <c>Size_i</c> is represented by <c>default</c>.
+ An omitted <c>TSL_i</c> is represented by <c>default</c>.</item>
+ <item>If E is a block expression <c>begin B end</c>,
+ where <c>B</c> is a body, then
+ Rep(E) = <c>{block,LINE,Rep(B)}</c>.</item>
+ <item>If E is a case expression <c>case E_0 of Cc_1 ; ... ; Cc_k end</c>,
+ where <c>E_0</c> is an expression and each <c>Cc_i</c> is a
+ case clause then Rep(E) =
+ <c>{'case',LINE,Rep(E_0),[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item>
+ <item>If E is a catch expression <c>catch E_0</c>, then
Rep(E) = <c>{'catch',LINE,Rep(E_0)}</c>.</item>
- <item>If E is <c>E_0(E_1, ..., E_k)</c>, then
+ <item>If E is a cons skeleton <c>[E_h | E_t]</c>, then
+ Rep(E) = <c>{cons,LINE,Rep(E_h),Rep(E_t)}</c>.</item>
+ <item>If E is a fun expression <c>fun Name/Arity</c>, then
+ Rep(E) = <c>{'fun',LINE,{function,Name,Arity}}</c>.</item>
+ <item>If E is a fun expression
+ <c>fun Module:Name/Arity</c>, then Rep(E) =
+ <c>{'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}</c>.
+ (Before the R15 release: Rep(E) =
+ <c>{'fun',LINE,{function,Module,Name,Arity}}</c>.)</item>
+ <item>If E is a fun expression <c>fun Fc_1 ; ... ; Fc_k end</c>,
+ where each <c>Fc_i</c> is a function clause then Rep(E) =
+ <c>{'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}</c>.</item>
+ <item>If E is a fun expression
+ <c>fun Name Fc_1 ; ... ; Name Fc_k end</c>,
+ where <c>Name</c> is a variable and each
+ <c>Fc_i</c> is a function clause then Rep(E) =
+ <c>{named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}</c>.
+ </item>
+ <item>If E is a function call <c>E_0(E_1, ..., E_k)</c>, then
Rep(E) = <c>{call,LINE,Rep(E_0),[Rep(E_1), ..., Rep(E_k)]}</c>.</item>
- <item>If E is <c>E_m:E_0(E_1, ..., E_k)</c>, then Rep(E) =
- <c>{call,LINE,{remote,LINE,Rep(E_m),Rep(E_0)},[Rep(E_1), ..., Rep(E_k)]}</c>.
+ <item>If E is a function call <c>E_m:E_0(E_1, ..., E_k)</c>,
+ then Rep(E) =
+ <c>{call,LINE,{remote,LINE,Rep(E_m),Rep(E_0)},[Rep(E_1), ..., Rep(E_k)]}</c>.
</item>
- <item>If E is a list comprehension <c>[E_0 || W_1, ..., W_k]</c>,
- where each <c>W_i</c> is a generator or a filter, then Rep(E) =
- <c>{lc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}</c>. For Rep(W), see
- below.</item>
- <item>If E is a binary comprehension
- <c>&lt;&lt;E_0 || W_1, ..., W_k>></c>,
- where each <c>W_i</c> is a generator or a filter, then
- Rep(E) = <c>{bc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}</c>.
- For Rep(W), see below.</item>
- <item>If E is <c>begin B end</c>, where <c>B</c> is a body, then
- Rep(E) = <c>{block,LINE,Rep(B)}</c>.</item>
- <item>If E is <c>if Ic_1 ; ... ; Ic_k end</c>,
+ <item>If E is an if expression <c>if Ic_1 ; ... ; Ic_k end</c>,
where each <c>Ic_i</c> is an if clause then Rep(E) =
<c>{'if',LINE,[Rep(Ic_1), ..., Rep(Ic_k)]}</c>.</item>
- <item>If E is <c>case E_0 of Cc_1 ; ... ; Cc_k end</c>,
- where <c>E_0</c> is an expression and each <c>Cc_i</c> is a
- case clause then Rep(E) =
- <c>{'case',LINE,Rep(E_0),[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item>
- <item>If E is <c>try B catch Tc_1 ; ... ; Tc_k end</c>,
+ <item>If E is a list comprehension <c>[E_0 || Q_1, ..., Q_k]</c>,
+ where each <c>Q_i</c> is a qualifier, then Rep(E) =
+ <c>{lc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}</c>. For Rep(Q), see
+ below.</item>
+ <item>If E is a map creation <c>#{A_1, ..., A_k}</c>,
+ where each <c>A_i</c> is an association <c>E_i_1 => E_i_2</c>
+ or <c>E_i_1 := E_i_2</c>, then Rep(E) =
+ <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see
+ below.</item>
+ <item>If E is a map update <c>E_0#{A_1, ..., A_k}</c>,
+ where each <c>A_i</c> is an association <c>E_i_1 => E_i_2</c>
+ or <c>E_i_1 := E_i_2</c>, then Rep(E) =
+ <c>{map,LINE,Rep(E_0),[Rep(A_1), ..., Rep(A_k)]}</c>.
+ For Rep(A), see below.</item>
+ <item>If E is a match operator expression <c>P = E_0</c>,
+ where <c>P</c> is a pattern, then
+ Rep(E) = <c>{match,LINE,Rep(P),Rep(E_0)}</c>.</item>
+ <item>If E is nil, <c>[]</c>, then
+ Rep(E) = <c>{nil,LINE}</c>.</item>
+ <item>If E is an operator expression <c>E_1 Op E_2</c>,
+ where <c>Op</c> is a binary operator other than the match
+ operator <c>=</c>, then
+ Rep(E) = <c>{op,LINE,Op,Rep(E_1),Rep(E_2)}</c>.</item>
+ <item>If E is an operator expression <c>Op E_0</c>,
+ where <c>Op</c> is a unary operator, then
+ Rep(E) = <c>{op,LINE,Op,Rep(E_0)}</c>.</item>
+ <item>If E is a parenthesized expression <c>( E_0 )</c>, then
+ Rep(E) = <c>Rep(E_0)</c>, that is, parenthesized
+ expressions cannot be distinguished from their bodies.</item>
+ <item>If E is a receive expression <c>receive Cc_1 ; ... ; Cc_k end</c>,
+ where each <c>Cc_i</c> is a case clause then Rep(E) =
+ <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item>
+ <item>If E is a receive expression
+ <c>receive Cc_1 ; ... ; Cc_k after E_0 -> B_t end</c>,
+ where each <c>Cc_i</c> is a case clause,
+ <c>E_0</c> is an expression and <c>B_t</c> is a body, then Rep(E) =
+ <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)],Rep(E_0),Rep(B_t)}</c>.</item>
+ <item>If E is a record creation
+ <c>#Name{Field_1=E_1, ..., Field_k=E_k}</c>,
+ where each <c>Field_i</c> is an atom or <c>_</c>, then Rep(E) =
+ <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item>
+ <item>If E is a record field access <c>E_0#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(E) = <c>{record_field,LINE,Rep(E_0),Name,Rep(Field)}</c>.</item>
+ <item>If E is a record field index <c>#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(E) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item>
+ <item>If E is a record update
+ <c>E_0#Name{Field_1=E_1, ..., Field_k=E_k}</c>,
+ where each <c>Field_i</c> is an atom, then Rep(E) =
+ <c>{record,LINE,Rep(E_0),Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item>
+ <item>If E is a tuple skeleton <c>{E_1, ..., E_k}</c>, then
+ Rep(E) = <c>{tuple,LINE,[Rep(E_1), ..., Rep(E_k)]}</c>.</item>
+ <item>If E is a try expression <c>try B catch Tc_1 ; ... ; Tc_k end</c>,
where <c>B</c> is a body and each <c>Tc_i</c> is a catch clause then
Rep(E) =
<c>{'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],[]}</c>.</item>
- <item>If E is <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n end</c>,
+ <item>If E is a try expression
+ <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n end</c>,
where <c>B</c> is a body,
each <c>Cc_i</c> is a case clause and
each <c>Tc_j</c> is a catch clause then Rep(E) =
<c>{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1), ..., Rep(Tc_n)],[]}</c>.</item>
- <item>If E is <c>try B after A end</c>,
+ <item>If E is a try expression <c>try B after A end</c>,
where <c>B</c> and <c>A</c> are bodies then Rep(E) =
<c>{'try',LINE,Rep(B),[],[],Rep(A)}</c>.</item>
- <item>If E is <c>try B of Cc_1 ; ... ; Cc_k after A end</c>,
+ <item>If E is a try expression
+ <c>try B of Cc_1 ; ... ; Cc_k after A end</c>,
where <c>B</c> and <c>A</c> are a bodies and
each <c>Cc_i</c> is a case clause then Rep(E) =
<c>{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[],Rep(A)}</c>.</item>
- <item>If E is <c>try B catch Tc_1 ; ... ; Tc_k after A end</c>,
+ <item>If E is a try expression
+ <c>try B catch Tc_1 ; ... ; Tc_k after A end</c>,
where <c>B</c> and <c>A</c> are bodies and
each <c>Tc_i</c> is a catch clause then Rep(E) =
<c>{'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],Rep(A)}</c>.</item>
- <item>If E is <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n after A end</c>,
+ <item>If E is a try expression
+ <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n after A end</c>,
where <c>B</c> and <c>A</c> are a bodies,
- each <c>Cc_i</c> is a case clause and
+ each <c>Cc_i</c> is a case clause, and
each <c>Tc_j</c> is a catch clause then
Rep(E) =
<c>{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1), ..., Rep(Tc_n)],Rep(A)}</c>.</item>
- <item>If E is <c>receive Cc_1 ; ... ; Cc_k end</c>,
- where each <c>Cc_i</c> is a case clause then Rep(E) =
- <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item>
- <item>If E is <c>receive Cc_1 ; ... ; Cc_k after E_0 -> B_t end</c>,
- where each <c>Cc_i</c> is a case clause,
- <c>E_0</c> is an expression and <c>B_t</c> is a body, then Rep(E) =
- <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)],Rep(E_0),Rep(B_t)}</c>.</item>
- <item>If E is <c>fun Name / Arity</c>, then
- Rep(E) = <c>{'fun',LINE,{function,Name,Arity}}</c>.</item>
- <item>If E is <c>fun Module:Name/Arity</c>, then Rep(E) =
- <c>{'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}</c>.
- (Before the R15 release: Rep(E) =
- <c>{'fun',LINE,{function,Module,Name,Arity}}</c>.)</item>
- <item>If E is <c>fun Fc_1 ; ... ; Fc_k end</c>
- where each <c>Fc_i</c> is a function clause then Rep(E) =
- <c>{'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}</c>.</item>
- <item>If E is <c>fun Name Fc_1 ; ... ; Name Fc_k end</c>
- where <c>Name</c> is a variable and each
- <c>Fc_i</c> is a function clause then Rep(E) =
- <c>{named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}</c>.
- </item>
- <item>If E is <c>( E_0 )</c>, then
- Rep(E) = <c>Rep(E_0)</c>, that is, parenthesized
- expressions cannot be distinguished from their bodies.</item>
+ <item>If E is a variable <c>V</c>, then Rep(E) = <c>{var,LINE,A}</c>,
+ where <c>A</c> is an atom with a printname consisting of the same
+ characters as <c>V</c>.</item>
</list>
<section>
- <title>Generators and Filters</title>
- <p>When W is a generator or a filter (in the body of a list or
- binary comprehension), then:</p>
+ <title>Qualifiers</title>
+ <p>A qualifier Q is one of the following alternatives:</p>
<list type="bulleted">
- <item>If W is a generator <c>P &lt;- E</c>, where <c>P</c> is
+ <item>If Q is a filter <c>E</c>, where <c>E</c> is an expression, then
+ Rep(Q) = <c>Rep(E)</c>.</item>
+ <item>If Q is a generator <c>P &lt;- E</c>, where <c>P</c> is
a pattern and <c>E</c> is an expression, then
- Rep(W) = <c>{generate,LINE,Rep(P),Rep(E)}</c>.</item>
- <item>If W is a generator <c>P &lt;= E</c>, where <c>P</c> is
+ Rep(Q) = <c>{generate,LINE,Rep(P),Rep(E)}</c>.</item>
+ <item>If Q is a generator <c>P &lt;= E</c>, where <c>P</c> is
a pattern and <c>E</c> is an expression, then
- Rep(W) = <c>{b_generate,LINE,Rep(P),Rep(E)}</c>.</item>
- <item>If W is a filter <c>E</c>, which is an expression, then
- Rep(W) = <c>Rep(E)</c>.</item>
+ Rep(Q) = <c>{b_generate,LINE,Rep(P),Rep(E)}</c>.</item>
</list>
</section>
<section>
<title>Binary Element Type Specifiers</title>
<p>A type specifier list TSL for a binary element is a sequence of type
- specifiers <c>TS_1 - ... - TS_k</c>.
+ specifiers <c>TS_1 - ... - TS_k</c>, and
Rep(TSL) = <c>[Rep(TS_1), ..., Rep(TS_k)]</c>.</p>
- <p>When TS is a type specifier for a binary element, then:</p>
<list type="bulleted">
- <item>If TS is an atom <c>A</c>, then Rep(TS) = <c>A</c>.</item>
- <item>If TS is a couple <c>A:Value</c> where <c>A</c> is an atom
- and <c>Value</c> is an integer, then Rep(TS) =
- <c>{A,Value}</c>.</item>
+ <item>If TS is a type specifier <c>A</c>, where <c>A</c> is an atom,
+ then Rep(TS) = <c>A</c>.</item>
+ <item>If TS is a type specifier <c>A:Value</c>,
+ where <c>A</c> is an atom and <c>Value</c> is an integer,
+ then Rep(TS) = <c>{A,Value}</c>.</item>
</list>
</section>
<section>
- <title>Map Assoc and Exact Fields</title>
- <p>When W is an assoc or exact field (in the body of a map), then:</p>
+ <title>Associations</title>
+ <p>An association A is one of the following alternatives:</p>
<list type="bulleted">
- <item>If W is an assoc field <c>K => V</c>, where
- <c>K</c> and <c>V</c> are both expressions,
- then Rep(W) = <c>{map_field_assoc,LINE,Rep(K),Rep(V)}</c>.
+ <item>If A is an association <c>K => V</c>,
+ then Rep(A) = <c>{map_field_assoc,LINE,Rep(K),Rep(V)}</c>.
</item>
- <item>If W is an exact field <c>K := V</c>, where
- <c>K</c> and <c>V</c> are both expressions,
- then Rep(W) = <c>{map_field_exact,LINE,Rep(K),Rep(V)}</c>.
+ <item>If A is an association <c>K := V</c>,
+ then Rep(A) = <c>{map_field_exact,LINE,Rep(K),Rep(V)}</c>.
</item>
</list>
</section>
@@ -398,39 +426,39 @@
and catch clauses.</p>
<p>A clause <c>C</c> is one of the following alternatives:</p>
<list type="bulleted">
- <item>If C is a function clause <c>( Ps ) -> B</c>
- where <c>Ps</c> is a pattern sequence and <c>B</c> is a body, then
- Rep(C) = <c>{clause,LINE,Rep(Ps),[],Rep(B)}</c>.</item>
- <item>If C is a function clause <c>( Ps ) when Gs -> B</c>
- where <c>Ps</c> is a pattern sequence,
- <c>Gs</c> is a guard sequence and <c>B</c> is a body, then
- Rep(C) = <c>{clause,LINE,Rep(Ps),Rep(Gs),Rep(B)}</c>.</item>
- <item>If C is an if clause <c>Gs -> B</c>
- where <c>Gs</c> is a guard sequence and <c>B</c> is a body, then
- Rep(C) = <c>{clause,LINE,[],Rep(Gs),Rep(B)}</c>.</item>
- <item>If C is a case clause <c>P -> B</c>
+ <item>If C is a case clause <c>P -> B</c>,
where <c>P</c> is a pattern and <c>B</c> is a body, then
Rep(C) = <c>{clause,LINE,[Rep(P)],[],Rep(B)}</c>.</item>
- <item>If C is a case clause <c>P when Gs -> B</c>
+ <item>If C is a case clause <c>P when Gs -> B</c>,
where <c>P</c> is a pattern,
<c>Gs</c> is a guard sequence and <c>B</c> is a body, then
Rep(C) = <c>{clause,LINE,[Rep(P)],Rep(Gs),Rep(B)}</c>.</item>
- <item>If C is a catch clause <c>P -> B</c>
+ <item>If C is a catch clause <c>P -> B</c>,
where <c>P</c> is a pattern and <c>B</c> is a body, then
Rep(C) = <c>{clause,LINE,[Rep({throw,P,_})],[],Rep(B)}</c>.</item>
- <item>If C is a catch clause <c>X : P -> B</c>
+ <item>If C is a catch clause <c>X : P -> B</c>,
where <c>X</c> is an atomic literal or a variable pattern,
- <c>P</c> is a pattern and <c>B</c> is a body, then
+ <c>P</c> is a pattern, and <c>B</c> is a body, then
Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],[],Rep(B)}</c>.</item>
- <item>If C is a catch clause <c>P when Gs -> B</c>
- where <c>P</c> is a pattern, <c>Gs</c> is a guard sequence
+ <item>If C is a catch clause <c>P when Gs -> B</c>,
+ where <c>P</c> is a pattern, <c>Gs</c> is a guard sequence,
and <c>B</c> is a body, then
Rep(C) = <c>{clause,LINE,[Rep({throw,P,_})],Rep(Gs),Rep(B)}</c>.</item>
- <item>If C is a catch clause <c>X : P when Gs -> B</c>
+ <item>If C is a catch clause <c>X : P when Gs -> B</c>,
where <c>X</c> is an atomic literal or a variable pattern,
- <c>P</c> is a pattern, <c>Gs</c> is a guard sequence
+ <c>P</c> is a pattern, <c>Gs</c> is a guard sequence,
and <c>B</c> is a body, then
Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],Rep(Gs),Rep(B)}</c>.</item>
+ <item>If C is a function clause <c>( Ps ) -> B</c>,
+ where <c>Ps</c> is a pattern sequence and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,Rep(Ps),[],Rep(B)}</c>.</item>
+ <item>If C is a function clause <c>( Ps ) when Gs -> B</c>,
+ where <c>Ps</c> is a pattern sequence,
+ <c>Gs</c> is a guard sequence and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,Rep(Ps),Rep(Gs),Rep(B)}</c>.</item>
+ <item>If C is an if clause <c>Gs -> B</c>,
+ where <c>Gs</c> is a guard sequence and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,[],Rep(Gs),Rep(B)}</c>.</item>
</list>
</section>
@@ -444,46 +472,61 @@
<c>[Rep(Gt_1), ..., Rep(Gt_k)]</c>.</p>
<p>A guard test <c>Gt</c> is one of the following alternatives:</p>
<list type="bulleted">
- <item>If Gt is an atomic literal L, then Rep(Gt) = Rep(L).</item>
- <item>If Gt is a variable pattern <c>V</c>, then
- Rep(Gt) = <c>{var,LINE,A}</c>, where A is an atom with
- a printname consisting of the same characters as <c>V</c>.</item>
- <item>If Gt is a tuple skeleton <c>{Gt_1, ..., Gt_k}</c>, then
- Rep(Gt) = <c>{tuple,LINE,[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item>
- <item>If Gt is <c>[]</c>, then Rep(Gt) = <c>{nil,LINE}</c>.</item>
- <item>If Gt is a cons skeleton <c>[Gt_h | Gt_t]</c>, then
- Rep(Gt) = <c>{cons,LINE,Rep(Gt_h),Rep(Gt_t)}</c>.</item>
+ <item>If Gt is an atomic literal <c>L</c>, then Rep(Gt) = Rep(L).</item>
<item>If Gt is a binary constructor
- <c>&lt;&lt;Gt_1:Size_1/TSL_1, ..., Gt_k:Size_k/TSL_k>></c>, then
+ <c>&lt;&lt;Gt_1:Size_1/TSL_1, ..., Gt_k:Size_k/TSL_k>></c>,
+ where each <c>Size_i</c> is a guard test and each
+ <c>TSL_i</c> is a type specificer list, then
Rep(Gt) = <c>{bin,LINE,[{bin_element,LINE,Rep(Gt_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(Gt_k),Rep(Size_k),Rep(TSL_k)}]}</c>.
For Rep(TSL), see above.
- An omitted <c>Size</c> is represented by <c>default</c>.
- An omitted <c>TSL</c> (type specifier list) is represented
- by <c>default</c>.</item>
- <item>If Gt is <c>Gt_1 Op Gt_2</c>, where <c>Op</c>
- is a binary operator, then Rep(Gt) =
- <c>{op,LINE,Op,Rep(Gt_1),Rep(Gt_2)}</c>.</item>
- <item>If Gt is <c>Op Gt_0</c>, where <c>Op</c> is a unary operator, then
+ An omitted <c>Size_i</c> is represented by <c>default</c>.
+ An omitted <c>TSL_i</c> is represented by <c>default</c>.</item>
+ <item>If Gt is a cons skeleton <c>[Gt_h | Gt_t]</c>, then
+ Rep(Gt) = <c>{cons,LINE,Rep(Gt_h),Rep(Gt_t)}</c>.</item>
+ <item>If Gt is a function call <c>A(Gt_1, ..., Gt_k)</c>,
+ where <c>A</c> is an atom, then Rep(Gt) =
+ <c>{call,LINE,Rep(A),[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item>
+ <item>If Gt is a function call <c>A_m:A(Gt_1, ..., Gt_k)</c>,
+ where <c>A_m</c> is the atom <c>erlang</c> and <c>A</c> is
+ an atom or an operator, then Rep(Gt) =
+ <c>{call,LINE,{remote,LINE,Rep(A_m),Rep(A)},[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item>
+ <item>If Gt is a map creation <c>#{A_1, ..., A_k}</c>,
+ where each <c>A_i</c> is an association <c>Gt_i_1 => Gt_i_2</c>
+ or <c>Gt_i_1 := Gt_i_2</c>, then Rep(Gt) =
+ <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see
+ above.</item>
+ <item>If Gt is a map update <c>Gt_0#{A_1, ..., A_k}</c>, where each
+ <c>A_i</c> is an association <c>Gt_i_1 => Gt_i_2</c>
+ or <c>Gt_i_1 := Gt_i_2</c>, then Rep(Gt) =
+ <c>{map,LINE,Rep(Gt_0),[Rep(A_1), ..., Rep(A_k)]}</c>.
+ For Rep(A), see above.</item>
+ <item>If Gt is nil, <c>[]</c>,
+ then Rep(Gt) = <c>{nil,LINE}</c>.</item>
+ <item>If Gt is an operator guard test <c>Gt_1 Op Gt_2</c>,
+ where <c>Op</c> is a binary operator other than the match
+ operator <c>=</c>, then
+ Rep(Gt) = <c>{op,LINE,Op,Rep(Gt_1),Rep(Gt_2)}</c>.</item>
+ <item>If Gt is an operator guard test <c>Op Gt_0</c>,
+ where <c>Op</c> is a unary operator, then
Rep(Gt) = <c>{op,LINE,Op,Rep(Gt_0)}</c>.</item>
- <item>If Gt is <c>#Name{Field_1=Gt_1, ..., Field_k=Gt_k}</c>, then
- Rep(E) =
- <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(Gt_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(Gt_k)}]}</c>.</item>
- <item>If Gt is <c>#Name.Field</c>, then
- Rep(Gt) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item>
- <item>If Gt is <c>Gt_0#Name.Field</c>, then
- Rep(Gt) = <c>{record_field,LINE,Rep(Gt_0),Name,Rep(Field)}</c>.</item>
- <item>If Gt is <c>A(Gt_1, ..., Gt_k)</c>, where <c>A</c> is an atom, then
- Rep(Gt) = <c>{call,LINE,Rep(A),[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item>
- <item>If Gt is <c>A_m:A(Gt_1, ..., Gt_k)</c>, where <c>A_m</c> is
- the atom <c>erlang</c> and <c>A</c> is an atom or an operator, then
- Rep(Gt) = <c>{call,LINE,{remote,LINE,Rep(A_m),Rep(A)},[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item>
- <item>If Gt is <c>{A_m,A}(Gt_1, ..., Gt_k)</c>, where <c>A_m</c> is
- the atom <c>erlang</c> and <c>A</c> is an atom or an operator, then
- Rep(Gt) = <c>{call,LINE,Rep({A_m,A}),[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.
- </item>
- <item>If Gt is <c>( Gt_0 )</c>, then
+ <item>If Gt is a parenthesized guard test <c>( Gt_0 )</c>, then
Rep(Gt) = <c>Rep(Gt_0)</c>, that is, parenthesized
guard tests cannot be distinguished from their bodies.</item>
+ <item>If Gt is a record creation
+ <c>#Name{Field_1=Gt_1, ..., Field_k=Gt_k}</c>,
+ where each <c>Field_i</c> is an atom or <c>_</c>, then Rep(Gt) =
+ <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(Gt_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(Gt_k)}]}</c>.</item>
+ <item>If Gt is a record field access <c>Gt_0#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(Gt) = <c>{record_field,LINE,Rep(Gt_0),Name,Rep(Field)}</c>.</item>
+ <item>If Gt is a record field index <c>#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(Gt) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item>
+ <item>If Gt is a tuple skeleton <c>{Gt_1, ..., Gt_k}</c>, then
+ Rep(Gt) = <c>{tuple,LINE,[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item>
+ <item>If Gt is a variable pattern <c>V</c>, then
+ Rep(Gt) = <c>{var,LINE,A}</c>, where A is an atom with
+ a printname consisting of the same characters as <c>V</c>.</item>
</list>
<p>Note that every guard test has the same source form as some expression,
and is represented the same way as the corresponding expression.</p>
@@ -492,21 +535,11 @@
<section>
<title>Types</title>
<list type="bulleted">
- <item>If T is an annotated type <c>Anno :: Type</c>,
- where <c>Anno</c> is a variable and
- <c>Type</c> is a type, then Rep(T) =
- <c>{ann_type,LINE,[Rep(Anno),Rep(Type)]}</c>.</item>
+ <item>If T is an annotated type <c>A :: T_0</c>,
+ where <c>A</c> is a variable, then Rep(T) =
+ <c>{ann_type,LINE,[Rep(A),Rep(T_0)]}</c>.</item>
<item>If T is an atom or integer literal L, then Rep(T) = Rep(L).
</item>
- <item>If T is <c>L Op R</c>,
- where <c>Op</c> is a binary operator and <c>L</c> and <c>R</c>
- are types (this is an occurrence of an expression that can be
- evaluated to an integer at compile time), then
- Rep(T) = <c>{op,LINE,Op,Rep(L),Rep(R)}</c>.</item>
- <item>If T is <c>Op A</c>, where <c>Op</c> is a
- unary operator and <c>A</c> is a type (this is an occurrence of
- an expression that can be evaluated to an integer at compile time),
- then Rep(T) = <c>{op,LINE,Op,Rep(A)}</c>.</item>
<item>If T is a bitstring type <c>&lt;&lt;_:M,_:_*N>></c>,
where <c>M</c> and <c>N</c> are singleton integer types, then Rep(T) =
<c>{type,LINE,binary,[Rep(M),Rep(N)]}</c>.</item>
@@ -514,69 +547,71 @@
<c>{type,Line,nil,[]}</c>.</item>
<item>If T is a fun type <c>fun()</c>, then Rep(T) =
<c>{type,LINE,'fun',[]}</c>.</item>
- <item>If T is a fun type <c>fun((...) -> B)</c>,
- where <c>B</c> is a type, then
- Rep(T) = <c>{type,LINE,'fun',[{type,LINE,any},Rep(B)]}</c>.
+ <item>If T is a fun type <c>fun((...) -> T_0)</c>, then
+ Rep(T) = <c>{type,LINE,'fun',[{type,LINE,any},Rep(T_0)]}</c>.
</item>
<item>If T is a fun type <c>fun(Ft)</c>, where
<c>Ft</c> is a function type,
- then Rep(T) = <c>Rep(Ft)</c>.</item>
+ then Rep(T) = <c>Rep(Ft)</c>. For Rep(Ft), see below.</item>
<item>If T is an integer range type <c>L .. H</c>,
where <c>L</c> and <c>H</c> are singleton integer types, then
Rep(T) = <c>{type,LINE,range,[Rep(L),Rep(H)]}</c>.</item>
<item>If T is a map type <c>map()</c>, then Rep(T) =
<c>{type,LINE,map,any}</c>.</item>
- <item>If T is a map type <c>#{P_1, ..., P_k}</c>, where each
- <c>P_i</c> is a map pair type, then Rep(T) =
- <c>{type,LINE,map,[Rep(P_1), ..., Rep(P_k)]}</c>.</item>
- <item>If T is a map pair type <c>K => V</c>, where
- <c>K</c> and <c>V</c> are types, then Rep(T) =
- <c>{type,LINE,map_field_assoc,[Rep(K),Rep(V)]}</c>.</item>
- <item>If T is a predefined (or built-in) type <c>N(A_1, ..., A_k)</c>,
- where each <c>A_i</c> is a type, then Rep(T) =
- <c>{type,LINE,N,[Rep(A_1), ..., Rep(A_k)]}</c>.</item>
+ <item>If T is a map type <c>#{A_1, ..., A_k}</c>, where each
+ <c>A_i</c> is an association type, then Rep(T) =
+ <c>{type,LINE,map,[Rep(A_1), ..., Rep(A_k)]}</c>.
+ For Rep(A), see below.</item>
+ <item>If T is an operator type <c>T_1 Op T_2</c>,
+ where <c>Op</c> is a binary operator (this is an occurrence of
+ an expression that can be evaluated to an integer at compile
+ time), then
+ Rep(T) = <c>{op,LINE,Op,Rep(T_1),Rep(T_2)}</c>.</item>
+ <item>If T is an operator type <c>Op T_0</c>, where <c>Op</c> is a
+ unary operator (this is an occurrence of
+ an expression that can be evaluated to an integer at compile time),
+ then Rep(T) = <c>{op,LINE,Op,Rep(T_0)}</c>.</item>
+ <item>If T is <c>( T_0 )</c>, then Rep(T) = <c>Rep(T_0)</c>,
+ that is, parenthesized types cannot be distinguished from their
+ bodies.</item>
+ <item>If T is a predefined (or built-in) type <c>N(T_1, ..., T_k)</c>,
+ then Rep(T) =
+ <c>{type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}</c>.</item>
<item>If T is a record type <c>#Name{F_1, ..., F_k}</c>,
where each <c>F_i</c> is a record field type, then Rep(T) =
<c>{type,LINE,record,[Rep(Name),Rep(F_1), ..., Rep(F_k)]}</c>.
- </item>
- <item>If T is a record field type <c>Name :: Type</c>,
- where <c>Type</c> is a type, then Rep(T) =
- <c>{type,LINE,field_type,[Rep(Name),Rep(Type)]}</c>.</item>
- <item>If T is a remote type <c>M:N(A_1, ..., A_k)</c>, where
- each <c>A_i</c> is a type, then Rep(T) =
- <c>{remote_type,LINE,[Rep(M),Rep(N),[Rep(A_1), ..., Rep(A_k)]]}</c>.
+ For Rep(F), see below.</item>
+ <item>If T is a remote type <c>M:N(T_1, ..., T_k)</c>, then Rep(T) =
+ <c>{remote_type,LINE,[Rep(M),Rep(N),[Rep(T_1), ..., Rep(T_k)]]}</c>.
</item>
<item>If T is a tuple type <c>tuple()</c>, then Rep(T) =
<c>{type,LINE,tuple,any}</c>.</item>
- <item>If T is a tuple type <c>{A_1, ..., A_k}</c>, where
- each <c>A_i</c> is a type, then Rep(T) =
- <c>{type,LINE,tuple,[Rep(A_1), ..., Rep(A_k)]}</c>.</item>
- <item>If T is a type union <c>T_1 | ... | T_k</c>,
- where each <c>T_i</c> is a type, then Rep(T) =
+ <item>If T is a tuple type <c>{T_1, ..., T_k}</c>, then Rep(T) =
+ <c>{type,LINE,tuple,[Rep(T_1), ..., Rep(T_k)]}</c>.</item>
+ <item>If T is a type union <c>T_1 | ... | T_k</c>, then Rep(T) =
<c>{type,LINE,union,[Rep(T_1), ..., Rep(T_k)]}</c>.</item>
<item>If T is a type variable <c>V</c>, then Rep(T) =
<c>{var,LINE,A}</c>, where <c>A</c> is an atom with a printname
consisting of the same characters as <c>V</c>. A type variable
is any variable except underscore (<c>_</c>).</item>
- <item>If T is a user-defined type <c>N(A_1, ..., A_k)</c>,
- where each <c>A_i</c> is a type, then Rep(T) =
- <c>{user_type,LINE,N,[Rep(A_1), ..., Rep(A_k)]}</c>.</item>
- <item>If T is <c>( T_0 )</c>, then Rep(T) = <c>Rep(T_0)</c>,
- that is, parenthesized types cannot be distinguished from their
- bodies.</item>
+ <item>If T is a user-defined type <c>N(T_1, ..., T_k)</c>,
+ then Rep(T) =
+ <c>{user_type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}</c>.</item>
</list>
<section>
<title>Function Types</title>
+ <p>A function type Ft is one of the following alternatives:</p>
<list type="bulleted">
<item>If Ft is a constrained function type <c>Ft_1 when Fc</c>,
where <c>Ft_1</c> is a function type and
<c>Fc</c> is a function constraint, then Rep(T) =
- <c>{type,LINE,bounded_fun,[Rep(Ft_1),Rep(Fc)]}</c>.</item>
- <item>If Ft is a function type <c>(A_1, ..., A_n) -> B</c>,
- where each <c>A_i</c> and <c>B</c> are types, then
- Rep(Ft) = <c>{type,LINE,'fun',[{type,LINE,product,[Rep(A_1),
- ..., Rep(A_n)]},Rep(B)]}</c>.</item>
+ <c>{type,LINE,bounded_fun,[Rep(Ft_1),Rep(Fc)]}</c>.
+ For Rep(Fc), see below.</item>
+ <item>If Ft is a function type <c>(T_1, ..., T_n) -> T_0</c>,
+ where each <c>T_i</c> is a type, then
+ Rep(Ft) = <c>{type,LINE,'fun',[{type,LINE,product,[Rep(T_1),
+ ..., Rep(T_n)]},Rep(T_0)]}</c>.</item>
</list>
</section>
@@ -592,6 +627,24 @@
</item>
</list>
</section>
+
+ <section>
+ <title>Association Types</title>
+ <list type="bulleted">
+ <item>If A is an association type <c>K => V</c>, where
+ <c>K</c> and <c>V</c> are types, then Rep(A) =
+ <c>{type,LINE,map_field_assoc,[Rep(K),Rep(V)]}</c>.</item>
+ </list>
+ </section>
+
+ <section>
+ <title>Record Field Types</title>
+ <list type="bulleted">
+ <item>If F is a record field type <c>Name :: Type</c>,
+ where <c>Type</c> is a type, then Rep(F) =
+ <c>{type,LINE,field_type,[Rep(Name),Rep(Type)]}</c>.</item>
+ </list>
+ </section>
</section>
<section>
diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml
index bad20d6343..ae7f264d0c 100644
--- a/erts/doc/src/driver_entry.xml
+++ b/erts/doc/src/driver_entry.xml
@@ -247,14 +247,10 @@ typedef struct erl_drv_entry {
something that the <c>WaitForMultipleObjects</c> API
function understands). (Some trickery in the emulator allows
more than the built-in limit of 64 <c>Events</c> to be used.)</p>
- <p>On Enea OSE the <c>event</c> is one or more signals that can
- be retrieved using <seealso marker="ose:ose_erl_driver#erl_drv_ose_get_signal">erl_drv_ose_get_signal</seealso>.</p>
<p>To use this with threads and asynchronous routines, create a
- pipe on unix, an Event on Windows or a unique signal number on
- Enea OSE. When the routine
+ pipe on unix and an Event on Windows. When the routine
completes, write to the pipe (use <c>SetEvent</c> on
- Windows or send a message to the emulator process on Enea OSE),
- this will make the emulator call
+ Windows), this will make the emulator call
<c>ready_input</c> or <c>ready_output</c>.</p>
<p>Spurious events may happen. That is, calls to <c>ready_input</c>
or <c>ready_output</c> even though no real events are signaled. In
@@ -441,7 +437,14 @@ typedef struct erl_drv_entry {
<seealso marker="erl_driver#erl_drv_busy_msgq_limits">erl_drv_busy_msgq_limits()</seealso>
function.
</item>
- </taglist>
+ <tag><c>ERL_DRV_FLAG_USE_INIT_ACK</c></tag>
+ <item>When this flag is given the linked-in driver has to manually
+ acknowledge that the port has been successfully started using
+ <seealso marker="erl_driver#erl_drv_init_ack">erl_drv_init_ack()</seealso>.
+ This allows the implementor to make the erlang:open_port exit with
+ badarg after some initial asynchronous initialization has been done.
+ </item>
+ </taglist>
</item>
<tag>void *handle2</tag>
<item>
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index e8621fecc3..1c4a0056a7 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -1339,6 +1339,21 @@
<seealso marker="kernel:error_logger#warning_map/0">error_logger(3)</seealso>
for further information.</p>
</item>
+ <tag><c><![CDATA[+xFlag Value]]></c></tag>
+ <item>
+ <p>Default process flag settings.</p>
+ <taglist>
+ <tag><marker id="+xmqd"><c>+xmqd off_heap|on_heap|mixed</c></marker></tag>
+ <item><p>
+ Sets the default value for the process flag
+ <c>message_queue_data</c>. If <c>+xmqd</c> is not
+ passed, <c>mixed</c> will be the default. For more information,
+ see the documentation of
+ <seealso marker="erlang#process_flag_message_queue_data"><c>process_flag(message_queue_data,
+ MQD)</c></seealso>.
+ </p></item>
+ </taglist>
+ </item>
<tag><c><![CDATA[+zFlag Value]]></c></tag>
<item>
<p>Miscellaneous flags.</p>
diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml
index 34dc8af238..241d4131d5 100644
--- a/erts/doc/src/erl_driver.xml
+++ b/erts/doc/src/erl_driver.xml
@@ -1077,9 +1077,7 @@ typedef struct ErlIOVec {
<c>select</c>/<c>poll</c> can use).
On windows, the Win32 API function <c>WaitForMultipleObjects</c>
is used. This places other restrictions on the event object.
- Refer to the Win32 SDK documentation.
- On Enea OSE, the receive function is used. See the <seealso
- marker="ose:ose_erl_driver"></seealso> for more details.</p>
+ Refer to the Win32 SDK documentation.</p>
<p>The <c>on</c> parameter should be <c>1</c> for setting events
and <c>0</c> for clearing them.</p>
<p>The <c>mode</c> argument is a bitwise-or combination of
@@ -1091,7 +1089,7 @@ typedef struct ErlIOVec {
<seealso marker="driver_entry#ready_output">ready_output</seealso>.
</p>
<note>
- <p>Some OS (Windows and Enea OSE) do not differentiate between read and write events.
+ <p>Some OS (Windows) do not differentiate between read and write events.
The call-back for a fired event then only depends on the value of <c>mode</c>.</p>
</note>
<p><c>ERL_DRV_USE</c> specifies if we are using the event object or if we want to close it.
@@ -2166,6 +2164,53 @@ ERL_DRV_MAP int sz
</func>
<func>
+ <name><ret>void</ret><nametext>erl_drv_init_ack(ErlDrvPort port, ErlDrvData res)</nametext></name>
+ <fsummary>Acknowledge the start of the port</fsummary>
+ <desc>
+ <marker id="erl_drv_init_ack"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>port</c></tag>
+ <item>The port handle of the port (driver instance) creating
+ doing the acknowledgment.
+ </item>
+ <tag><c>res</c></tag>
+ <item>The result of the port initialization. This can be the same values
+ as the return value of <seealso marker="driver_entry#start">start</seealso>,
+ i.e any of the error codes or the ErlDrvData that is to be used for this
+ port.
+ </item>
+ </taglist>
+ <p>
+ When this function is called the initiating erlang:open_port call is
+ returned as if the <seealso marker="driver_entry#start">start</seealso>
+ function had just been called. It can only be used when the
+ <seealso marker="driver_entry#driver_flags">ERL_DRV_FLAG_USE_INIT_ACK</seealso>
+ flag has been set on the linked-in driver.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name><ret>void</ret><nametext>erl_drv_set_os_pid(ErlDrvPort port, ErlDrvSInt pid)</nametext></name>
+ <fsummary>Set the os_pid for the port</fsummary>
+ <desc>
+ <marker id="erl_drv_set_os_pid"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>port</c></tag>
+ <item>The port handle of the port (driver instance) to set the pid on.
+ </item>
+ <tag><c>pid</c></tag>
+ <item>The pid to set.</item>
+ </taglist>
+ <p>
+ Set the os_pid seen when doing erlang:port_info/2 on this port.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>int</ret><nametext>erl_drv_thread_create(char *name,
ErlDrvTid *tid,
void * (*func)(void *),
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml
index 420c9fea38..be0e406b9c 100644
--- a/erts/doc/src/erl_nif.xml
+++ b/erts/doc/src/erl_nif.xml
@@ -753,7 +753,7 @@ typedef enum {
<func><name><ret>int</ret><nametext>enif_get_list_length(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len)</nametext></name>
<fsummary>Get the length of list <c>term</c></fsummary>
<desc><p>Set <c>*len</c> to the length of list <c>term</c> and return true,
- or return false if <c>term</c> is not a list.</p></desc>
+ or return false if <c>term</c> is not a proper list.</p></desc>
</func>
<func><name><ret>int</ret><nametext>enif_get_long(ErlNifEnv* env, ERL_NIF_TERM term, long int* ip)</nametext></name>
<fsummary>Read an long integer term</fsummary>
diff --git a/erts/doc/src/erl_prim_loader.xml b/erts/doc/src/erl_prim_loader.xml
index db4f132609..8f66e07ae1 100644
--- a/erts/doc/src/erl_prim_loader.xml
+++ b/erts/doc/src/erl_prim_loader.xml
@@ -50,36 +50,9 @@
<c>-loader_debug</c> are also experimental</p></warning>
</description>
- <datatypes>
- <datatype>
- <name name="host"/>
- </datatype>
- </datatypes>
<funcs>
<func>
- <name name="start" arity="3"/>
- <fsummary>Start the Erlang low level loader</fsummary>
- <desc>
- <p>Starts the Erlang low level loader. This function is called
- by the <c>init</c> process (and module). The <c>init</c>
- process reads the command line flags <c>-id <anno>Id</anno></c>,
- <c>-loader <anno>Loader</anno></c>, and <c>-hosts <anno>Hosts</anno></c>. These are
- the arguments supplied to the <c>start/3</c> function.</p>
- <p>If <c>-loader</c> is not given, the default loader is
- <c>efile</c> which tells the system to read from the file
- system.</p>
- <p>If <c>-loader</c> is <c>inet</c>, the <c>-id <anno>Id</anno></c>,
- <c>-hosts <anno>Hosts</anno></c>, and <c>-setcookie Cookie</c> flags must
- also be supplied. <c><anno>Hosts</anno></c> identifies hosts which this
- node can contact in order to load modules. One Erlang
- runtime system with a <c>erl_boot_server</c> process must be
- started on each of hosts given in <c><anno>Hosts</anno></c> in order to
- answer the requests. See <seealso
- marker="kernel:erl_boot_server">erl_boot_server(3)</seealso>.</p>
- </desc>
- </func>
- <func>
<name name="get_file" arity="1"/>
<fsummary>Get a file</fsummary>
<desc>
@@ -87,8 +60,6 @@
<c><anno>Filename</anno></c> is either an absolute file name or just the name
of the file, for example <c>"lists.beam"</c>. If an internal
path is set to the loader, this path is used to find the file.
- If a user supplied loader is used, the path can be stripped
- off if it is obsolete, and the loader does not use a path.
<c><anno>FullName</anno></c> is the complete name of the fetched file.
<c><anno>Bin</anno></c> is the contents of the file as a binary.</p>
@@ -189,17 +160,12 @@
<p>Specifies which other Erlang nodes the <c>inet</c> loader
can use. This flag is mandatory if the <c>-loader inet</c>
flag is present. On each host, there must be on Erlang node
- with the <c>erl_boot_server</c> which handles the load
- requests. <c>Hosts</c> is a list of IP addresses (hostnames
+ with the <seealso
+ marker="kernel:erl_boot_server">erl_boot_server(3)</seealso>
+ which handles the load requests.
+ <c>Hosts</c> is a list of IP addresses (hostnames
are not acceptable).</p>
</item>
- <tag><c>-id Id</c></tag>
- <item>
- <p>Specifies the identity of the Erlang runtime system. If
- the system runs as a distributed node, <c>Id</c> must be
- identical to the name supplied with the <c>-sname</c> or
- <c>-name</c> distribution flags.</p>
- </item>
<tag><c>-setcookie Cookie</c></tag>
<item>
<p>Specifies the cookie of the Erlang runtime system. This flag
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index e4d5e6e77a..803da382ed 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -59,6 +59,12 @@
</datatype>
<datatype>
+ <name name="message_queue_data"></name>
+ <desc><p>See <seealso marker="#process_flag_message_queue_data"><c>erlang:process_flag(message_queue_data, MQD)</c></seealso>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
<name name="timestamp"></name>
<desc><p>See <seealso marker="#timestamp/0">erlang:timestamp/0</seealso>.</p>
</desc>
@@ -125,6 +131,17 @@
</note>
</item>
+ <tag><c>perf_counter</c></tag>
+ <item><p>Symbolic representation of the performance counter
+ time unit used by the Erlang runtime system.</p>
+
+ <p>The <c>perf_counter</c> time unit behaves much in the same way
+ as the <c>native</c> time unit. That is it might differ inbetween
+ run-time restarts. You get values of this type by calling
+ <seealso marker="kernel:os#perf_counter/0"><c>os:perf_counter()</c></seealso>
+ </p>
+ </item>
+
</taglist>
<p>The <c>time_unit/0</c> type may be extended. Use
@@ -1105,7 +1122,7 @@
<fsummary>Prints a term on standard output.</fsummary>
<desc>
<p>Prints a text representation of <c><anno>Term</anno></c> on the
- standard output. On OSE, the term is printed to the ramlog.</p>
+ standard output.</p>
<warning>
<p>This BIF is intended for debugging only.</p>
</warning>
@@ -4280,9 +4297,59 @@ os_prompt% </pre>
<p>Returns the old value of the flag.</p>
</desc>
</func>
-
+ <marker id="process_flag_message_queue_data"/>
<func>
<name name="process_flag" arity="2" clause_i="5"/>
+ <fsummary>Set process flag <c>message_queue_data</c> for the calling process</fsummary>
+ <type name="message_queue_data"/>
+ <desc>
+ <p>This flag determines how messages in the message queue
+ are stored. When the flag is:</p>
+ <taglist>
+ <tag><c>off_heap</c></tag>
+ <item><p>
+ <em>All</em> messages in the message queue will be stored
+ outside of the process heap. This implies that <em>no</em>
+ messages in the message queue will be part of a garbage
+ collection of the process.
+ </p></item>
+ <tag><c>on_heap</c></tag>
+ <item><p>
+ All messages in the message queue will eventually be
+ placed on heap. They may however temporarily be stored
+ off heap. This is how messages always have been stored
+ up until ERTS version 8.0.
+ </p></item>
+ <tag><c>mixed</c></tag>
+ <item><p>
+ Messages may be placed either on the heap or outside
+ of the heap.
+ </p></item>
+ </taglist>
+ <p>
+ The default <c>message_queue_data</c> process flag is determined
+ by the <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso>
+ <c>erl</c> command line argument.
+ </p>
+ <p>
+ If the process potentially may get a hugh amount of messages,
+ you are recommended to set the flag to <c>off_heap</c>. This
+ since a garbage collection with lots of messages placed on
+ the heap may become extremly expensive and the process may
+ consume large amounts of memory. Performance of the
+ actual message passing is however generally better when not
+ using the <c>off_heap</c> flag.
+ </p>
+ <p>
+ When changing this flag messages will be moved. This work
+ has been initiated but not completed when this function
+ call returns.
+ </p>
+ <p>Returns the old value of the flag.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="process_flag" arity="2" clause_i="6"/>
<fsummary>Sets process flag <c>priority</c> for the calling process.</fsummary>
<type name="priority_level"/>
<desc>
@@ -4356,7 +4423,7 @@ os_prompt% </pre>
</func>
<func>
- <name name="process_flag" arity="2" clause_i="6"/>
+ <name name="process_flag" arity="2" clause_i="7"/>
<fsummary>Sets process flag <c>save_calls</c> for the calling process.</fsummary>
<desc>
<p><c><anno>N</anno></c> must be an integer in the interval 0..10000.
@@ -4387,7 +4454,7 @@ os_prompt% </pre>
</func>
<func>
- <name name="process_flag" arity="2" clause_i="7"/>
+ <name name="process_flag" arity="2" clause_i="8"/>
<fsummary>Sets process flag <c>sensitive</c> for the calling process.</fsummary>
<desc>
<p>Sets or clears flag <c>sensitive</c> for the current process.
@@ -4441,6 +4508,7 @@ os_prompt% </pre>
<type name="process_info_result_item"/>
<type name="priority_level"/>
<type name="stack_item"/>
+ <type name="message_queue_data" />
<desc>
<p>Returns a list containing <c><anno>InfoTuple</anno></c>s with
miscellaneous information about the process identified by
@@ -4493,6 +4561,7 @@ os_prompt% </pre>
<type name="process_info_result_item"/>
<type name="stack_item"/>
<type name="priority_level"/>
+ <type name="message_queue_data" />
<desc>
<p>Returns information about the process identified by
<c><anno>Pid</anno></c>, as specified by
@@ -4584,6 +4653,17 @@ os_prompt% </pre>
The content of <c><anno>GCInfo</anno></c> can be changed without
prior notice.</p>
</item>
+ <tag><c>{garbage_collection_info, <anno>GCInfo</anno>}</c></tag>
+ <item>
+ <p><c><anno>GCInfo</anno></c> is a list containing miscellaneous
+ detailed information about garbage collection for this process.
+ The content of <c><anno>GCInfo</anno></c> can be changed without
+ prior notice.
+ See <seealso marker="#gc_start">gc_start</seealso> in
+ <seealso marker="#trace/3">erlang:trace/3</seealso> for details about
+ what each item means.
+ </p>
+ </item>
<tag><c>{group_leader, <anno>GroupLeader</anno>}</c></tag>
<item>
<p><c><anno>GroupLeader</anno></c> is group leader for the I/O of
@@ -4661,6 +4741,15 @@ os_prompt% </pre>
monitor by name, the list item is
<c>{process, {<anno>RegName</anno>, <anno>Node</anno>}}</c>.</p>
</item>
+ <tag><c>{message_queue_data, <anno>MQD</anno>}</c></tag>
+ <item>
+ <p>Returns the current state of the <c>message_queue_data</c>
+ process flag. <c><anno>MQD</anno></c> is either <c>off_heap</c>,
+ <c>on_heap</c>, or <c>mixed</c>. For more information, see the
+ documentation of
+ <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data,
+ MQD)</c></seealso>.</p>
+ </item>
<tag><c>{priority, <anno>Level</anno>}</c></tag>
<item>
<p><c><anno>Level</anno></c> is the current priority level for
@@ -4803,6 +4892,12 @@ os_prompt% </pre>
<seealso marker="kernel:code">code(3)</seealso>)
and is not to be used elsewhere.</p>
</warning>
+ <note>
+ <p>As from <c>ERTS</c> 8.0 (OTP 19), any lingering processes
+ that still execute the old code will be killed by this function.
+ In earlier versions, such incorrect use could cause much
+ more fatal failures, like emulator crash.</p>
+ </note>
<p>Failure: <c>badarg</c> if there is no old code for
<c><anno>Module</anno></c>.</p>
</desc>
@@ -5429,6 +5524,8 @@ true</pre>
<name name="spawn_opt" arity="2"/>
<fsummary>Creates a new process with a fun as entry point.</fsummary>
<type name="priority_level"/>
+ <type name="message_queue_data" />
+ <type name="spawn_opt_option" />
<desc>
<p>Returns the process identifier (pid) of a new process
started by the application of <c><anno>Fun</anno></c>
@@ -5444,6 +5541,8 @@ true</pre>
<name name="spawn_opt" arity="3"/>
<fsummary>Creates a new process with a fun as entry point on a given node.</fsummary>
<type name="priority_level"/>
+ <type name="message_queue_data" />
+ <type name="spawn_opt_option" />
<desc>
<p>Returns the process identifier (pid) of a new process started
by the application of <c><anno>Fun</anno></c> to the
@@ -5458,6 +5557,8 @@ true</pre>
<name name="spawn_opt" arity="4"/>
<fsummary>Creates a new process with a function as entry point.</fsummary>
<type name="priority_level"/>
+ <type name="message_queue_data" />
+ <type name="spawn_opt_option" />
<desc>
<p>Works as
<seealso marker="#spawn/3">spawn/3</seealso>, except that an
@@ -5559,6 +5660,18 @@ true</pre>
fine-tuning an application and to measure the execution
time with various <c><anno>VSize</anno></c> values.</p>
</item>
+ <tag><c>{message_queue_data, <anno>MQD</anno>}</c></tag>
+ <item>
+ <p>Sets the state of the <c>message_queue_data</c> process
+ flag. <c><anno>MQD</anno></c> should be either <c>off_heap</c>,
+ <c>on_heap</c>, or <c>mixed</c>. The default
+ <c>message_queue_data</c> process flag is determined by the
+ <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso> <c>erl</c>
+ command line argument. For more information, see the
+ documentation of
+ <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data,
+ <anno>MQD</anno>)</c></seealso>.</p>
+ </item>
</taglist>
</desc>
</func>
@@ -5567,6 +5680,8 @@ true</pre>
<name name="spawn_opt" arity="5"/>
<fsummary>Creates a new process with a function as entry point on a given node.</fsummary>
<type name="priority_level"/>
+ <type name="message_queue_data" />
+ <type name="spawn_opt_option" />
<desc>
<p>Returns the process identifier (pid) of a new process started
by the application
@@ -5755,6 +5870,146 @@ true</pre>
<func>
<name name="statistics" arity="1" clause_i="6"/>
+ <fsummary>Information about microstate accounting.</fsummary>
+ <desc>
+ <marker id="statistics_microstate_accounting"></marker>
+ <p>
+ Microstate accounting can be used to measure how much time the Erlang
+ runtime system spends doing various tasks. It is designed to be as
+ lightweight as possible, but there will be some overhead when this
+ is enabled. Microstate accounting is meant to be a profiling tool
+ to help figure out performance bottlenecks.
+ To <c>start</c>/<c>stop</c>/<c>reset</c> microstate_accounting you use
+ the system_flag
+ <seealso marker="#system_flag_microstate_accounting">
+ <c>microstate_accounting</c></seealso>.
+ </p>
+ <p>
+ <c>erlang:statistics(microstate_accounting)</c> returns a list of maps
+ representing some of the OS threads within ERTS. Each map contains
+ <c>type</c> and <c>id</c> fields that can be used to identify what
+ thread it is, and also a counters field that contains data about how
+ much time has been spent in the various states.</p>
+ <pre>
+> <input>erlang:statistics(microstate_accounting).</input>
+[#{counters => #{aux => 1899182914,
+ check_io => 2605863602,
+ emulator => 45731880463,
+ gc => 1512206910,
+ other => 5421338456,
+ port => 221631,
+ sleep => 5150294100},
+ id => 1,
+ type => scheduler}|...]
+ </pre>
+ <p>The time unit is the same as returned by
+ <seealso marker="kernel:os#perf_counter/0">
+ <c>os:perf_counter/0</c></seealso>.
+ So to convert it to milliseconds you could do something like this:</p>
+ <pre>
+lists:map(
+ fun(#{ counters := Cnt } = M) ->
+ MsCnt = maps:map(fun(_K, PerfCount) ->
+ erlang:convert_time_unit(PerfCount, perf_counter, 1000)
+ end, Cnt),
+ M#{ counters := MsCnt }
+ end, erlang:statistics(microstate_accounting)).
+ </pre>
+ <p>
+ It is important to note that these values are not guaranteed to be
+ the exact time spent in each state. This is because of various
+ optimisation done in order to keep the overhead as small as possible.
+ </p>
+
+ <p>Currently the following <c><anno>MSAcc_Thread_Type</anno></c> are available:</p>
+ <taglist>
+ <tag><c>scheduler</c></tag>
+ <item>The main execution threads that do most of the work.</item>
+ <tag><c>async</c></tag><item>Async threads are used by various
+ linked-in drivers (mainly the file drivers) do offload non-cpu
+ intensive work.</item>
+ <tag><c>aux</c></tag><item>Takes care of any work that is not
+ specifically assigned to a scheduler.</item>
+ </taglist>
+ <p>Currently the following <c><anno>MSAcc_Thread_State</anno></c>s are available.
+ All states are exclusive, meaning that a thread cannot be in two states
+ at once. So if you add the numbers of all counters in a thread
+ you will get the total run-time for that thread.</p>
+ <taglist>
+ <tag><c>aux</c></tag>
+ <item>Time spent handling auxiliary jobs.</item>
+ <tag><c>check_io</c></tag>
+ <item>Time spent checking for new I/O events.</item>
+ <tag><c>emulator</c></tag>
+ <item>Time spent executing erlang processes.</item>
+ <tag><c>gc</c></tag>
+ <item>Time spent doing garbage collection. When extra states are
+ enabled this is the time spent doing non-fullsweep garbage
+ collections.</item>
+ <tag><c>other</c></tag>
+ <item>Time spent doing unaccounted things.</item>
+ <tag><c>port</c></tag>
+ <item>Time spent executing ports.</item>
+ <tag><c>sleep</c></tag>
+ <item>Time spent sleeping.</item>
+ </taglist>
+ <p>It is possible to add more fine grained <c><anno>MSAcc_Thread_State</anno></c>s
+ through configure.
+ (e.g. <c>./configure --with-microstate-accounting=extra</c>).
+ Enabling these states will cause a performance degradation when
+ microstate accounting is turned off and increase the overhead when
+ it is turned on.</p>
+ <taglist>
+ <tag><c>alloc</c></tag>
+ <item>Time spent managing memory. Without extra states this time is
+ spread out over all other states.</item>
+ <tag><c>bif</c></tag>
+ <item>Time spent in bifs. Without extra states this time is part of
+ the <c>emulator</c> state.</item>
+ <tag><c>busy_wait</c></tag>
+ <item>Time spent busy waiting. This is also the state where a
+ scheduler no longer reports that it is active when using
+ <seealso marker="#statistics_scheduler_wall_time">
+ <c>erlang:statistics(scheduler_wall_time)</c></seealso>.
+ So if you add all other states but this and sleep and then divide that
+ by all time in the thread you should get something very similar to the
+ scheduler_wall_time fraction. Without extra states this time is part
+ of the <c>other</c> state.</item>
+ <tag><c>ets</c></tag>
+ <item>Time spent executing ETS bifs. Without extra states this time is
+ part of the <c>emulator</c> state.</item>
+ <tag><c>gc_full</c></tag>
+ <item>Time spent doing fullsweep garbage collection. Without extra
+ states this time is part of the <c>gc</c> state.</item>
+ <tag><c>nif</c></tag>
+ <item>Time spent in nifs. Without extra states this time is part of
+ the <c>emulator</c> state.</item>
+ <tag><c>send</c></tag>
+ <item>Time spent sending messages (processes only). Without extra
+ states this time is part of the <c>emulator</c> state.</item>
+ <tag><c>timers</c></tag>
+ <item>Time spent managing timers. Without extra states this time is
+ part of the <c>other</c> state.</item>
+ </taglist>
+ <p>There is a utility module called
+ <seealso marker="runtime_tools:msacc"><c>msacc</c></seealso> in
+ runtime_tools that can be used to more easily analyse these
+ statistics.</p>
+
+ <p>
+ Returns <c>undefined</c> if the system flag
+ <seealso marker="#system_flag_microstate_accounting">
+ <c>microstate_accounting</c></seealso>
+ is turned off.
+ </p>
+ <p>The list of thread information is unsorted and may appear in
+ different order between calls.</p>
+ <note><p>The threads and states are subject to change without any
+ prior notice.</p></note>
+ </desc>
+ </func>
+ <func>
+ <name name="statistics" arity="1" clause_i="7"/>
<fsummary>Information about reductions.</fsummary>
<desc>
<marker id="statistics_reductions"></marker>
@@ -5772,7 +6027,7 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="7"/>
+ <name name="statistics" arity="1" clause_i="8"/>
<fsummary>Information about the run-queues.</fsummary>
<desc><marker id="statistics_run_queue"></marker>
<p>
@@ -5788,7 +6043,7 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="8"/>
+ <name name="statistics" arity="1" clause_i="9"/>
<fsummary>Information about the run-queue lengths.</fsummary>
<desc><marker id="statistics_run_queue_lengths"></marker>
<p>
@@ -5808,7 +6063,7 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="9"/>
+ <name name="statistics" arity="1" clause_i="10"/>
<fsummary>Information about runtime.</fsummary>
<desc>
<p>Returns information about runtime, in milliseconds.</p>
@@ -5823,7 +6078,7 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="10"/>
+ <name name="statistics" arity="1" clause_i="11"/>
<fsummary>Information about each schedulers work time.</fsummary>
<desc>
<marker id="statistics_scheduler_wall_time"></marker>
@@ -5894,7 +6149,7 @@ ok
</func>
<func>
- <name name="statistics" arity="1" clause_i="11"/>
+ <name name="statistics" arity="1" clause_i="12"/>
<fsummary>Information about active processes and ports.</fsummary>
<desc><marker id="statistics_total_active_tasks"></marker>
<p>
@@ -5912,7 +6167,7 @@ ok
</func>
<func>
- <name name="statistics" arity="1" clause_i="12"/>
+ <name name="statistics" arity="1" clause_i="13"/>
<fsummary>Information about the run-queue lengths.</fsummary>
<desc><marker id="statistics_total_run_queue_lengths"></marker>
<p>
@@ -5931,7 +6186,7 @@ ok
</func>
<func>
- <name name="statistics" arity="1" clause_i="13"/>
+ <name name="statistics" arity="1" clause_i="14"/>
<fsummary>Information about wall clock.</fsummary>
<desc>
<p>Returns information about wall clock. <c>wall_clock</c> can
@@ -6165,6 +6420,17 @@ ok
<func>
<name name="system_flag" arity="2" clause_i="5"/>
+ <fsummary>Set system flag microstate_accounting</fsummary>
+ <desc><p><marker id="system_flag_microstate_accounting"></marker>
+ Turns on/off microstate accounting measurements. By passing reset it is possible to reset
+ all counters to 0.</p>
+ <p>For more information see,
+ <seealso marker="#statistics_microstate_accounting">erlang:statistics(microstate_accounting)</seealso>.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name name="system_flag" arity="2" clause_i="6"/>
<fsummary>Sets system flag <c>min_heap_size</c>.</fsummary>
<desc>
<p>Sets the default minimum heap size for processes. The size
@@ -6179,7 +6445,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="6"/>
+ <name name="system_flag" arity="2" clause_i="7"/>
<fsummary>Sets system flag <c>min_bin_vheap_size</c>.</fsummary>
<desc>
<p>Sets the default minimum binary virtual heap size for
@@ -6196,7 +6462,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="7"/>
+ <name name="system_flag" arity="2" clause_i="8"/>
<fsummary>Sets system flag <c>multi_scheduling</c>.</fsummary>
<desc>
<p><marker id="system_flag_multi_scheduling"></marker>
@@ -6234,7 +6500,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="8"/>
+ <name name="system_flag" arity="2" clause_i="9"/>
<fsummary>Sets system flag <c>scheduler_bind_type</c>.</fsummary>
<type name="scheduler_bind_type"/>
<desc>
@@ -6352,7 +6618,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="9"/>
+ <name name="system_flag" arity="2" clause_i="10"/>
<fsummary>Sets system flag <c>scheduler_wall_time</c>.</fsummary>
<desc><p><marker id="system_flag_scheduler_wall_time"></marker>
Turns on or off scheduler wall time measurements.</p>
@@ -6362,7 +6628,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="10"/>
+ <name name="system_flag" arity="2" clause_i="11"/>
<fsummary>Sets system flag <c>schedulers_online</c>.</fsummary>
<desc>
<p><marker id="system_flag_schedulers_online"></marker>
@@ -6387,7 +6653,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="11"/>
+ <name name="system_flag" arity="2" clause_i="12"/>
<fsummary>Sets system flag <c>trace_control_word</c>.</fsummary>
<desc>
<p>Sets the value of the node trace control word to
@@ -6726,6 +6992,7 @@ ok
<name name="system_info" arity="1" clause_i="65"/>
<name name="system_info" arity="1" clause_i="66"/>
<name name="system_info" arity="1" clause_i="67"/>
+ <name name="system_info" arity="1" clause_i="68"/>
<fsummary>Information about the system.</fsummary>
<desc>
<p>Returns various information about the current system
@@ -7131,7 +7398,17 @@ ok
used by the runtime system. It is on the form
"&lt;major ver&gt;.&lt;minor ver&gt;".</p>
</item>
- <tag><c>otp_release</c></tag>
+ <tag><marker id="system_info_message_queue_data"><c>message_queue_data</c></marker></tag>
+ <item>
+ <p>Returns the default value of the <c>message_queue_data</c>
+ process flag which is either <c>off_heap</c>, <c>on_heap</c>, or <c>mixed</c>.
+ This default is set by the <c>erl</c> command line argument
+ <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso>. For more information on the
+ <c>message_queue_data</c> process flag, see documentation of
+ <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data,
+ MQD)</c></seealso>.</p>
+ </item>
+ <tag><marker id="system_info_otp_release"><c>otp_release</c></marker></tag>
<item>
<marker id="system_info_otp_release"></marker>
<p>Returns a string containing the OTP release number of the
diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml
index fe26df61f7..2a33096d04 100644
--- a/erts/doc/src/init.xml
+++ b/erts/doc/src/init.xml
@@ -247,10 +247,7 @@
<c>Expr</c> during system initialization. If any of these
steps fail (syntax error, parse error or exception during
evaluation), Erlang stops with an error message. Here is an
- example that seeds the random number generator:</p>
- <pre>
-% <input>erl -eval '{X,Y,Z} = now(), random:seed(X,Y,Z).'</input></pre>
- <p>This example uses Erlang as a hexadecimal calculator:</p>
+ example that uses Erlang as a hexadecimal calculator:</p>
<pre>
% <input>erl -noshell -eval 'R = 16#1F+16#A0, io:format("~.16B~n", [R])' \\</input>
<input>-s erlang halt</input>
diff --git a/erts/doc/src/run_erl.xml b/erts/doc/src/run_erl.xml
index 0a5b2c6136..faec3c68c1 100644
--- a/erts/doc/src/run_erl.xml
+++ b/erts/doc/src/run_erl.xml
@@ -59,7 +59,7 @@
first argument to run_erl on the command line.</item>
<tag>pipe_dir</tag>
<item>This is where to put the named pipe, usually
- <c><![CDATA[/tmp/]]></c> on Unix or <c><![CDATA[/pipe/]]></c> on OSE. It shall be suffixed by a <c><![CDATA[/]]></c> (slash),
+ <c><![CDATA[/tmp/]]></c>. It shall be suffixed by a <c><![CDATA[/]]></c> (slash),
i.e. not <c><![CDATA[/tmp/epipies]]></c>, but <c><![CDATA[/tmp/epipes/]]></c>. </item>
<tag>log_dir</tag>
<item>This is where the log files are written. There will be one
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index a919f0e3ac..12148ad9c7 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -23,10 +23,6 @@ include ../vsn.mk
include $(ERL_TOP)/make/$(TARGET)/otp.mk
-include $(TARGET)/gen_git_version.mk
-ifeq ($(findstring ose,$(TARGET)),ose)
-include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk
-endif
-
ENABLE_ALLOC_TYPE_VARS = @ENABLE_ALLOC_TYPE_VARS@
HIPE_ENABLED=@HIPE_ENABLED@
DTRACE_ENABLED=@DTRACE_ENABLED@
@@ -245,9 +241,7 @@ HCC = @HCC@
LD = @LD@
DEXPORT = @DEXPORT@
RANLIB = @RANLIB@
-ifneq ($(findstring ose,$(TARGET)),ose)
STRIP = strip
-endif
PERL = @PERL@
RM = @RM@
MKDIR = @MKDIR@
@@ -323,7 +317,7 @@ else
CS_CFLAGS = $(CS_CFLAGS_)
endif
CS_LDFLAGS = $(LDFLAGS)
-CS_LIBS = -L../lib/internal/$(TARGET) -lerts_internal$(TYPEMARKER) @ERTS_INTERNAL_X_LIBS@
+CS_LIBS = -L../lib/internal/$(TARGET) -lerts_internal$(TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ @SOCKET_LIBS@
LIBS += @TERMCAP_LIB@ -L../lib/internal/$(TARGET) @ERTS_INTERNAL_X_LIBS@
@@ -404,7 +398,7 @@ EMULATOR_EXECUTABLE = beam$(TF_MARKER).dll
else
EMULATOR_EXECUTABLE = beam$(TF_MARKER)
endif
-CS_EXECUTABLE = child_setup$(TYPEMARKER)
+CS_EXECUTABLE = erl_child_setup$(TYPEMARKER)
# ----------------------------------------------------------------------
@@ -597,6 +591,7 @@ ifeq ($(TARGET),win32)
PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
PRELOAD_SRC = $(TARGET)/beams.rc
$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \
$(ERL_TOP)/erts/preloaded/ebin/init.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
@@ -606,11 +601,13 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
$(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \
$(ERL_TOP)/erts/preloaded/ebin/erlang.beam \
$(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam
+
$(gen_verbose)LANG=C $(PERL) utils/make_preload $(MAKE_PRELOAD_EXTRA) -rc $^ > $@
else
PRELOAD_OBJ = $(OBJDIR)/preload.o
PRELOAD_SRC = $(TARGET)/preload.c
$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \
$(ERL_TOP)/erts/preloaded/ebin/init.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
@@ -684,14 +681,6 @@ $(OBJDIR)/%.o: $(TTF_DIR)/%.c
$(OBJDIR)/%.o: sys/$(ERLANG_OSTYPE)/%.c
$(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(OBJDIR)/ose_confd.o: $(OSE_CONFD)
- $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
-
-$(OBJDIR)/crt0_lm.o: $(CRT0_LM)
- $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
-endif
-
$(OBJDIR)/%.o: sys/common/%.c
$(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
@@ -704,11 +693,11 @@ $(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c
# ----------------------------------------------------------------------
# Specials
#
-CS_SRC = sys/$(ERLANG_OSTYPE)/erl_child_setup.c
+CS_OBJ = $(OBJDIR)/erl_child_setup.o $(OBJDIR)/sys_uds.o $(OBJDIR)/hash.o
-$(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_SRC) $(ERTS_LIB)
- $(ld_verbose)$(CS_PURIFY) $(CC) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \
- $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_SRC) $(CS_LIBS)
+$(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_OBJ) $(ERTS_LIB)
+ $(ld_verbose)$(CS_PURIFY) $(LD) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \
+ $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_OBJ) $(CS_LIBS)
$(OBJDIR)/%.kp.o: sys/common/%.c
$(V_CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
@@ -787,7 +776,8 @@ RUN_OBJS = \
$(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \
$(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o \
$(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o \
- $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o
+ $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \
+ $(OBJDIR)/erl_msacc.o
ifeq ($(TARGET),win32)
DRV_OBJS = \
@@ -810,31 +800,10 @@ OS_OBJS = \
$(OBJDIR)/dosmap.o
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-OS_OBJS = \
- $(OBJDIR)/sys.o \
- $(OBJDIR)/driver_tab.o \
- $(OBJDIR)/ose_efile.o \
- $(OBJDIR)/gzio.o \
- $(OBJDIR)/elib_memmove.o
-
-OS_OBJS += $(OBJDIR)/ose_confd.o \
- $(OBJDIR)/crt0_lm.o
-
-OS_OBJS += $(OBJDIR)/sys_float.o \
- $(OBJDIR)/sys_time.o
-
-DRV_OBJS = \
- $(OBJDIR)/efile_drv.o \
- $(OBJDIR)/ose_signal_drv.o \
- $(OBJDIR)/inet_drv.o \
- $(OBJDIR)/zlib_drv.o \
- $(OBJDIR)/ram_file_drv.o \
- $(OBJDIR)/ttsl_drv.o
-
-else
OS_OBJS = \
$(OBJDIR)/sys.o \
+ $(OBJDIR)/sys_drivers.o \
+ $(OBJDIR)/sys_uds.o \
$(OBJDIR)/driver_tab.o \
$(OBJDIR)/unix_efile.o \
$(OBJDIR)/gzio.o \
@@ -849,7 +818,6 @@ DRV_OBJS = \
$(OBJDIR)/ram_file_drv.o \
$(OBJDIR)/ttsl_drv.o
endif
-endif
ifneq ($(STATIC_NIFS),no)
STATIC_NIF_LIBS = $(STATIC_NIFS)
@@ -1022,19 +990,12 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS)
$(STATIC_DRIVER_LIBS) $(LIBS)
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(LCF)
- $(call build-ose-load-module, $@, $(INIT_OBJS) $(OBJS), $(STATIC_NIF_LIBS) \
- $(STATIC_DRIVER_LIBS) $(LIBS), $(BEAM_LMCONF))
-
-else
$(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS)
$(ld_verbose)$(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \
$(HIPEBEAMLDFLAGS) $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) \
$(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS) $(LIBS)
endif
-endif
# ----------------------------------------------------------------------
# Dependencies
diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c
index fe91134ef4..099c00bcf6 100644
--- a/erts/emulator/beam/atom.c
+++ b/erts/emulator/beam/atom.c
@@ -176,7 +176,7 @@ atom_alloc(Atom* tmpl)
/*
* Precompute ordinal value of first 3 bytes + 7 bits.
- * This is used by utils.c:cmp_atoms().
+ * This is used by utils.c:erts_cmp_atoms().
* We cannot use the full 32 bits of the first 4 bytes,
* since we use the sign of the difference between two
* ordinal values to represent their relative order.
@@ -435,6 +435,9 @@ init_atom_table(void)
f.cmp = (HCMP_FUN) atom_cmp;
f.alloc = (HALLOC_FUN) atom_alloc;
f.free = (HFREE_FUN) atom_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
atom_text_pos = NULL;
atom_text_end = NULL;
diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h
index ead56c83d8..2c002ca92f 100644
--- a/erts/emulator/beam/atom.h
+++ b/erts/emulator/beam/atom.h
@@ -129,6 +129,7 @@ typedef enum {
(erts_is_atom_utf8_bytes((byte *) LSTR, sizeof(LSTR) - 1, (TERM)))
#define ERTS_DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
#define ERTS_INIT_AM(S) AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
+#define ERTS_MAKE_AM(Str) am_atom_put(Str, sizeof(Str) - 1)
int atom_table_size(void); /* number of elements */
int atom_table_sz(void); /* table size in bytes, excluding stored objects */
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index cb6d294a41..2777c3d112 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -102,6 +102,7 @@ atom asynchronous
atom atom
atom atom_used
atom attributes
+atom await_microstate_accounting_modifications
atom await_port_send_result
atom await_proc_exit
atom await_result
@@ -118,10 +119,9 @@ 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
@@ -173,6 +173,7 @@ atom const
atom context_switches
atom control
atom copy
+atom counters
atom cpu
atom cpu_timestamp
atom cr
@@ -211,6 +212,7 @@ atom dsend_continue_trap
atom dunlink
atom duplicate_bag
atom dupnames
+atom einval
atom elib_malloc
atom emulator
atom enable_trace
@@ -258,6 +260,7 @@ atom functions
atom function_clause
atom garbage_collecting
atom garbage_collection
+atom garbage_collection_info
atom gc_end
atom gc_start
atom Ge='>='
@@ -268,6 +271,7 @@ 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
@@ -353,17 +357,20 @@ atom memory_internal
atom memory_types
atom message
atom message_binary
+atom message_queue_data
atom message_queue_len
atom messages
atom merge_trap
atom meta
atom meta_match_spec
atom micro_seconds
+atom microstate_accounting
atom milli_seconds
atom min_heap_size
atom min_bin_vheap_size
atom minor_version
atom Minus='-'
+atom mixed
atom module
atom module_info
atom monitored_by
@@ -427,10 +434,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
@@ -441,13 +450,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
@@ -592,6 +594,8 @@ atom trace trace_ts traced
atom trace_control_word
atom tracer
atom trap_exit
+atom trim
+atom trim_all
atom try_clause
atom true
atom tuple
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 0e192b1ebd..1b4c022370 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -38,9 +38,9 @@
#include "erl_thr_progress.h"
static void set_default_trace_pattern(Eterm module);
-static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp);
+static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp);
static void delete_code(Module* modp);
-static void decrement_refc(BeamInstr* code);
+static void decrement_refc(BeamCodeHeader*);
static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
@@ -58,8 +58,8 @@ BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
return am_undefined;
}
erts_rlock_old_code(code_ix);
- res = (erts_is_module_native(modp->curr.code) ||
- erts_is_module_native(modp->old.code)) ?
+ res = (erts_is_module_native(modp->curr.code_hdr) ||
+ erts_is_module_native(modp->old.code_hdr)) ?
am_true : am_false;
erts_runlock_old_code(code_ix);
return res;
@@ -81,7 +81,7 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
modp = erts_get_module(BIF_ARG_1, erts_active_code_ix());
if (modp && modp->curr.num_breakpoints > 0) {
- ASSERT(modp->curr.code != NULL);
+ ASSERT(modp->curr.code_hdr != NULL);
erts_clear_module_break(modp);
ASSERT(modp->curr.num_breakpoints == 0);
}
@@ -154,7 +154,7 @@ static struct /* Protected by code_write_permission */
{
Process* stager;
ErtsThrPrgrLaterOp lop;
-}commiter_state;
+} committer_state;
#endif
static Eterm
@@ -179,8 +179,8 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions)
BIF_RETTYPE
finish_loading_1(BIF_ALIST_1)
{
- int i;
- int n;
+ Sint i;
+ Sint n;
struct m* p = NULL;
Uint exceptions;
Eterm res;
@@ -201,7 +201,7 @@ finish_loading_1(BIF_ALIST_1)
*/
n = erts_list_length(BIF_ARG_1);
- if (n == -1) {
+ if (n < 0) {
ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
goto done;
}
@@ -281,7 +281,7 @@ finish_loading_1(BIF_ALIST_1)
exceptions = 0;
for (i = 0; i < n; i++) {
p[i].exception = 0;
- if (p[i].modp->curr.code && p[i].modp->old.code) {
+ if (p[i].modp->curr.code_hdr && p[i].modp->old.code_hdr) {
p[i].exception = 1;
exceptions++;
}
@@ -367,9 +367,9 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking,
* schedulers to read active code_ix in a safe way while executing
* without any memory barriers at all.
*/
- ASSERT(commiter_state.stager == NULL);
- commiter_state.stager = c_p;
- erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &commiter_state.lop);
+ ASSERT(committer_state.stager == NULL);
+ committer_state.stager = c_p;
+ erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &committer_state.lop);
erts_proc_inc_refc(c_p);
erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
/*
@@ -385,11 +385,11 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking,
#ifdef ERTS_SMP
static void smp_code_ix_commiter(void* null)
{
- Process* p = commiter_state.stager;
+ Process* p = committer_state.stager;
erts_commit_staging_code_ix();
#ifdef DEBUG
- commiter_state.stager = NULL;
+ committer_state.stager = NULL;
#endif
erts_release_code_write_permission();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
@@ -417,7 +417,7 @@ check_old_code_1(BIF_ALIST_1)
modp = erts_get_module(BIF_ARG_1, code_ix);
if (modp != NULL) {
erts_rlock_old_code(code_ix);
- if (modp->old.code != NULL) {
+ if (modp->old.code_hdr) {
res = am_true;
}
erts_runlock_old_code(code_ix);
@@ -426,7 +426,7 @@ check_old_code_1(BIF_ALIST_1)
}
Eterm
-erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
+erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp)
{
Module* modp;
Eterm res;
@@ -441,7 +441,8 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
if (!modp)
return am_false;
erts_rlock_old_code(code_ix);
- res = modp->old.code ? check_process_code(c_p, modp, allow_gc, redsp) : am_false;
+ res = (!modp->old.code_hdr ? am_false :
+ check_process_code(c_p, modp, flags, redsp));
erts_runlock_old_code(code_ix);
return res;
@@ -450,49 +451,21 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2)
{
int reds = 0;
+ Uint flags;
Eterm res;
- Eterm olist = BIF_ARG_2;
- int allow_gc = 1;
if (is_not_atom(BIF_ARG_1))
goto badarg;
- while (is_list(olist)) {
- Eterm *lp = list_val(olist);
- Eterm opt = CAR(lp);
- if (is_tuple(opt)) {
- Eterm* tp = tuple_val(opt);
- switch (arityval(tp[0])) {
- case 2:
- switch (tp[1]) {
- case am_allow_gc:
- switch (tp[2]) {
- case am_false:
- allow_gc = 0;
- break;
- case am_true:
- allow_gc = 1;
- break;
- default:
- goto badarg;
- }
- break;
- default:
- goto badarg;
- }
- break;
- default:
- goto badarg;
- }
- }
- else
- goto badarg;
- olist = CDR(lp);
+ if (is_not_small(BIF_ARG_2))
+ goto badarg;
+
+ flags = unsigned_val(BIF_ARG_2);
+ if (flags & ~ERTS_CPC_ALL) {
+ goto badarg;
}
- if (is_not_nil(olist))
- goto badarg;
- res = erts_check_process_code(BIF_P, BIF_ARG_1, allow_gc, &reds);
+ res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds);
ASSERT(is_value(res));
@@ -525,7 +498,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1)
if (!modp) {
res = am_undefined;
}
- else if (modp->old.code != 0) {
+ else if (modp->old.code_hdr) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
erts_dsprintf(dsbufp, "Module %T must be purged before loading\n",
BIF_ARG_1);
@@ -563,8 +536,8 @@ BIF_RETTYPE module_loaded_1(BIF_ALIST_1)
}
code_ix = erts_active_code_ix();
if ((modp = erts_get_module(BIF_ARG_1, code_ix)) != NULL) {
- if (modp->curr.code != NULL
- && modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] == 0) {
+ if (modp->curr.code_hdr
+ && modp->curr.code_hdr->on_load_function_ptr == NULL) {
res = am_true;
}
}
@@ -611,8 +584,8 @@ BIF_RETTYPE call_on_load_function_1(BIF_ALIST_1)
{
Module* modp = erts_get_module(BIF_ARG_1, erts_active_code_ix());
- if (modp && modp->curr.code) {
- BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]);
+ if (modp && modp->curr.code_hdr) {
+ BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code_hdr->on_load_function_ptr);
}
else {
BIF_ERROR(BIF_P, BADARG);
@@ -623,7 +596,6 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
{
ErtsCodeIndex code_ix;
Module* modp;
- Eterm on_load;
if (!erts_try_seize_code_write_permission(BIF_P)) {
ERTS_BIF_YIELD2(bif_export[BIF_finish_after_on_load_2],
@@ -638,14 +610,14 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
code_ix = erts_active_code_ix();
modp = erts_get_module(BIF_ARG_1, code_ix);
- if (!modp || modp->curr.code == 0) {
+ if (!modp || !modp->curr.code_hdr) {
error:
erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_release_code_write_permission();
BIF_ERROR(BIF_P, BADARG);
}
- if ((on_load = modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]) == 0) {
+ if (modp->curr.code_hdr->on_load_function_ptr == NULL) {
goto error;
}
if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) {
@@ -667,7 +639,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
ep->code[4] = 0;
}
}
- modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] = 0;
+ modp->curr.code_hdr->on_load_function_ptr = NULL;
set_default_trace_pattern(BIF_ARG_1);
} else if (BIF_ARG_2 == am_false) {
BeamInstr* code;
@@ -679,13 +651,16 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
* the current code; the old code is not touched.
*/
erts_total_code_size -= modp->curr.code_length;
- code = modp->curr.code;
- end = (BeamInstr *)((char *)code + modp->curr.code_length);
+ code = (BeamInstr*) modp->curr.code_hdr;
+ end = (BeamInstr *) ((char *)code + modp->curr.code_length);
erts_cleanup_funs_on_purge(code, end);
beam_catches_delmod(modp->curr.catches, code, modp->curr.code_length,
erts_active_code_ix());
- erts_free(ERTS_ALC_T_CODE, (void *) code);
- modp->curr.code = NULL;
+ if (modp->curr.code_hdr->literals_start) {
+ erts_free(ERTS_ALC_T_LITERAL, modp->curr.code_hdr->literals_start);
+ }
+ erts_free(ERTS_ALC_T_CODE, modp->curr.code_hdr);
+ modp->curr.code_hdr = NULL;
modp->curr.code_length = 0;
modp->curr.catches = BEAM_CATCHES_NIL;
erts_remove_from_ranges(code);
@@ -721,31 +696,50 @@ set_default_trace_pattern(Eterm module)
}
}
+static ERTS_INLINE int
+check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size)
+{
+ struct erl_off_heap_header* oh;
+ for (oh = off_heap->first; oh; oh = oh->next) {
+ if (thing_subtag(oh->thing_word) == FUN_SUBTAG) {
+ ErlFunThing* funp = (ErlFunThing*) oh;
+ if (ErtsInArea(funp->fe->address, area, area_size))
+ return !0;
+ }
+ }
+ return 0;
+}
+
+
static Eterm
-check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
+check_process_code(Process* rp, Module* modp, Uint flags, int *redsp)
{
BeamInstr* start;
+ char* literals;
+ Uint lit_bsize;
char* mod_start;
Uint mod_size;
- BeamInstr* end;
Eterm* sp;
- struct erl_off_heap_header* oh;
int done_gc = 0;
+ int need_gc = 0;
+ ErtsMessage *msgp;
+ ErlHeapFragment *hfrag;
-#define INSIDE(a) (start <= (a) && (a) < end)
+#define ERTS_ORDINARY_GC__ (1 << 0)
+#define ERTS_LITERAL_GC__ (1 << 1)
/*
* Pick up limits for the module.
*/
- start = modp->old.code;
- end = (BeamInstr *)((char *)start + modp->old.code_length);
+ start = (BeamInstr*) modp->old.code_hdr;
mod_start = (char *) start;
mod_size = modp->old.code_length;
/*
* Check if current instruction or continuation pointer points into module.
*/
- if (INSIDE(rp->i) || INSIDE(rp->cp)) {
+ if (ErtsInArea(rp->i, mod_start, mod_size)
+ || ErtsInArea(rp->cp, mod_start, mod_size)) {
return am_true;
}
@@ -753,7 +747,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
* Check all continuation pointers stored on the stack.
*/
for (sp = rp->stop; sp < STACK_START(rp); sp++) {
- if (is_CP(*sp) && INSIDE(cp_val(*sp))) {
+ if (is_CP(*sp) && ErtsInArea(cp_val(*sp), mod_start, mod_size)) {
return am_true;
}
}
@@ -767,15 +761,15 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
struct StackTrace *s;
ASSERT(is_list(rp->ftrace));
s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace)));
- if ((s->pc && INSIDE(s->pc)) ||
- (s->current && INSIDE(s->current))) {
+ if ((s->pc && ErtsInArea(s->pc, mod_start, mod_size)) ||
+ (s->current && ErtsInArea(s->current, mod_start, mod_size))) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
} else {
int i;
for (i = 0; i < s->depth; i++) {
- if (INSIDE(s->trace[i])) {
+ if (ErtsInArea(s->trace[i], mod_start, mod_size)) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
@@ -796,111 +790,147 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
}
/*
- * See if there are funs that refer to the old version of the module.
+ * Message queue can contains funs, but (at least currently) no
+ * constants. If we got references to this module from the message
+ * queue, a GC cannot remove these...
*/
- rescan:
- for (oh = MSO(rp).first; oh; oh = oh->next) {
- if (thing_subtag(oh->thing_word) == FUN_SUBTAG) {
- ErlFunThing* funp = (ErlFunThing*) oh;
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
- if (INSIDE((BeamInstr *) funp->fe->address)) {
- if (done_gc) {
- return am_true;
- } else {
- if (!allow_gc)
- return am_aborted;
- /*
- * Try to get rid of this fun by garbage collecting.
- * Clear both fvalue and ftrace to make sure they
- * don't hold any funs.
- */
- rp->freason = EXC_NULL;
- rp->fvalue = NIL;
- rp->ftrace = NIL;
- done_gc = 1;
- FLAGS(rp) |= F_NEED_FULLSWEEP;
- *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
- goto rescan;
- }
- }
+ literals = (char*) modp->old.code_hdr->literals_start;
+ lit_bsize = (char*) modp->old.code_hdr->literals_end - literals;
+
+ for (msgp = rp->msg.first; msgp; msgp = msgp->next) {
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ hfrag = &msgp->hfrag;
+ else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag)
+ hfrag = msgp->data.heap_frag;
+ else
+ continue;
+ for (; hfrag; hfrag = hfrag->next) {
+ if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size))
+ return am_true;
+ /* Should not contain any constants... */
+ ASSERT(!any_heap_refs(&hfrag->mem[0],
+ &hfrag->mem[hfrag->used_size],
+ literals,
+ lit_bsize));
}
}
- /*
- * See if there are constants inside the module referenced by the process.
- */
- done_gc = 0;
- for (;;) {
- ErlMessage* mp;
-
- if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, mod_start, mod_size)) {
+ while (1) {
+
+ /* Check heap, stack etc... */
+ if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size))
+ goto try_gc;
+ if (!(flags & ERTS_CPC_COPY_LITERALS)) {
+ /* Process ok. May contain old literals but we will be called
+ * again before module is purged.
+ */
+ return am_false;
+ }
+ if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
}
- if (any_heap_ref_ptrs(rp->stop, rp->hend, mod_start, mod_size)) {
- goto need_gc;
- }
- if (any_heap_refs(rp->heap, rp->htop, mod_start, mod_size)) {
- goto need_gc;
- }
-
- if (any_heap_refs(rp->old_heap, rp->old_htop, mod_start, mod_size)) {
- goto need_gc;
+ if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize))
+ goto try_literal_gc;
+ if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize))
+ goto try_literal_gc;
+ if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize))
+ goto try_literal_gc;
+
+ /* Check dictionary */
+ if (rp->dictionary) {
+ Eterm* start = ERTS_PD_START(rp->dictionary);
+ Eterm* end = start + ERTS_PD_SIZE(rp->dictionary);
+
+ if (any_heap_ref_ptrs(start, end, literals, lit_bsize))
+ goto try_literal_gc;
}
- if (rp->dictionary != NULL) {
- Eterm* start = rp->dictionary->data;
- Eterm* end = start + rp->dictionary->used;
+ /* Check heap fragments */
+ for (hfrag = rp->mbuf; hfrag; hfrag = hfrag->next) {
+ Eterm *hp, *hp_end;
+ /* Off heap lists should already have been moved into process */
+ ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size));
- if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) {
- goto need_gc;
- }
+ hp = &hfrag->mem[0];
+ hp_end = &hfrag->mem[hfrag->used_size];
+ if (any_heap_refs(hp, hp_end, literals, lit_bsize))
+ goto try_literal_gc;
}
- for (mp = rp->msg.first; mp != NULL; mp = mp->next) {
- if (any_heap_ref_ptrs(mp->m, mp->m+2, mod_start, mod_size)) {
- goto need_gc;
+#ifdef DEBUG
+ /*
+ * Message buffer fragments should not have any references
+ * to constants, and off heap lists should already have
+ * been moved into process off heap structure.
+ */
+ for (msgp = rp->msg_frag; msgp; msgp = msgp->next) {
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ hfrag = &msgp->hfrag;
+ else
+ hfrag = msgp->data.heap_frag;
+ for (; hfrag; hfrag = hfrag->next) {
+ Eterm *hp, *hp_end;
+ ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size));
+
+ hp = &hfrag->mem[0];
+ hp_end = &hfrag->mem[hfrag->used_size];
+ ASSERT(!any_heap_refs(hp, hp_end, literals, lit_bsize));
}
}
- break;
- need_gc:
- if (done_gc) {
+#endif
+
+ return am_false;
+
+ try_literal_gc:
+ need_gc |= ERTS_LITERAL_GC__;
+
+ try_gc:
+ need_gc |= ERTS_ORDINARY_GC__;
+
+ if ((done_gc & need_gc) == need_gc)
return am_true;
- } else {
- Eterm* literals;
- Uint lit_size;
- struct erl_off_heap_header* oh;
- if (!allow_gc)
- return am_aborted;
+ if (!(flags & ERTS_CPC_ALLOW_GC))
+ return am_aborted;
- /*
- * Try to get rid of constants by by garbage collecting.
- * Clear both fvalue and ftrace.
- */
- rp->freason = EXC_NULL;
- rp->fvalue = NIL;
- rp->ftrace = NIL;
- done_gc = 1;
+ need_gc &= ~done_gc;
+
+ /*
+ * Try to get rid of constants by by garbage collecting.
+ * Clear both fvalue and ftrace.
+ */
+
+ rp->freason = EXC_NULL;
+ rp->fvalue = NIL;
+ rp->ftrace = NIL;
+
+ if (need_gc & ERTS_ORDINARY_GC__) {
FLAGS(rp) |= F_NEED_FULLSWEEP;
- *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
- literals = (Eterm *) modp->old.code[MI_LITERALS_START];
- lit_size = (Eterm *) modp->old.code[MI_LITERALS_END] - literals;
- oh = (struct erl_off_heap_header *)
- modp->old.code[MI_LITERALS_OFF_HEAP];
- *redsp += lit_size / 10; /* Need, better value... */
- erts_garbage_collect_literals(rp, literals, lit_size, oh);
+ *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity);
+ done_gc |= ERTS_ORDINARY_GC__;
}
+ if (need_gc & ERTS_LITERAL_GC__) {
+ struct erl_off_heap_header* oh;
+ oh = modp->old.code_hdr->literals_off_heap;
+ *redsp += lit_bsize / 64; /* Need, better value... */
+ erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh);
+ done_gc |= ERTS_LITERAL_GC__;
+ }
+ need_gc = 0;
}
- return am_false;
-#undef INSIDE
-}
-#define in_area(ptr,start,nbytes) \
- ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
+#undef ERTS_ORDINARY_GC__
+#undef ERTS_LITERAL_GC__
+
+}
static int
any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
@@ -913,7 +943,7 @@ any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
case TAG_PRIMARY_LIST:
- if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) {
+ if (ErtsInArea(val, mod_start, mod_size)) {
return 1;
}
break;
@@ -933,7 +963,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
case TAG_PRIMARY_LIST:
- if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) {
+ if (ErtsInArea(val, mod_start, mod_size)) {
return 1;
}
break;
@@ -943,7 +973,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
if (header_is_bin_matchstate(val)) {
ErlBinMatchState *ms = (ErlBinMatchState*) p;
ErlBinMatchBuffer *mb = &(ms->mb);
- if (in_area(EXPAND_POINTER(mb->orig), mod_start, mod_size)) {
+ if (ErtsInArea(mb->orig, mod_start, mod_size)) {
return 1;
}
}
@@ -958,7 +988,104 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
#undef in_area
-BIF_RETTYPE purge_module_1(BIF_ALIST_1)
+#ifdef ERTS_SMP
+static void copy_literals_commit(void*);
+#endif
+
+copy_literals_t erts_clrange = {NULL, 0, THE_NON_VALUE};
+
+/* copy literals
+ *
+ * copy_literals.ptr = LitPtr
+ * copy_literals.sz = LitSz
+ * ------ THR PROG COMMIT -----
+ *
+ * - check process code
+ * - check process code
+ * ...
+ * copy_literals.ptr = NULL
+ * copy_literals.sz = 0
+ * ------ THR PROG COMMIT -----
+ * ...
+ */
+
+
+BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2)
+{
+ ErtsCodeIndex code_ix;
+ Eterm res = am_true;
+
+ if (is_not_atom(BIF_ARG_1) || (am_true != BIF_ARG_2 && am_false != BIF_ARG_2)) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ if (!erts_try_seize_code_write_permission(BIF_P)) {
+ ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_copy_literals_2],
+ BIF_P, BIF_ARG_1, BIF_ARG_2);
+ }
+
+ code_ix = erts_active_code_ix();
+
+ if (BIF_ARG_2 == am_true) {
+ Module* modp = erts_get_module(BIF_ARG_1, code_ix);
+ if (!modp || !modp->old.code_hdr) {
+ res = am_false;
+ goto done;
+ }
+ if (erts_clrange.ptr != NULL
+ && !(BIF_P->static_flags & ERTS_STC_FLG_SYSTEM_PROC)) {
+ res = am_aborted;
+ goto done;
+ }
+ erts_clrange.ptr = modp->old.code_hdr->literals_start;
+ erts_clrange.sz = modp->old.code_hdr->literals_end - erts_clrange.ptr;
+ erts_clrange.pid = BIF_P->common.id;
+ } else if (BIF_ARG_2 == am_false) {
+ if (erts_clrange.pid != BIF_P->common.id) {
+ res = am_false;
+ goto done;
+ }
+ erts_clrange.ptr = NULL;
+ erts_clrange.sz = 0;
+ erts_clrange.pid = THE_NON_VALUE;
+ }
+
+#ifdef ERTS_SMP
+ ASSERT(committer_state.stager == NULL);
+ committer_state.stager = BIF_P;
+ erts_schedule_thr_prgr_later_op(copy_literals_commit, NULL, &committer_state.lop);
+ erts_proc_inc_refc(BIF_P);
+ erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+#endif
+done:
+ erts_release_code_write_permission();
+ BIF_RET(res);
+}
+
+#ifdef ERTS_SMP
+static void copy_literals_commit(void* null) {
+ Process* p = committer_state.stager;
+#ifdef DEBUG
+ committer_state.stager = NULL;
+#endif
+ erts_release_code_write_permission();
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ if (!ERTS_PROC_IS_EXITING(p)) {
+ erts_resume(p, ERTS_PROC_LOCK_STATUS);
+ }
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_dec_refc(p);
+}
+#endif /* ERTS_SMP */
+
+
+/* Do the actualy module purging and return:
+ * true for success
+ * false if no such old module
+ * BADARG if not an atom
+ */
+BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1)
{
ErtsCodeIndex code_ix;
BeamInstr* code;
@@ -972,7 +1099,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
}
if (!erts_try_seize_code_write_permission(BIF_P)) {
- ERTS_BIF_YIELD1(bif_export[BIF_purge_module_1], BIF_P, BIF_ARG_1);
+ ERTS_BIF_YIELD1(bif_export[BIF_erts_internal_purge_module_1],
+ BIF_P, BIF_ARG_1);
}
code_ix = erts_active_code_ix();
@@ -982,7 +1110,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
*/
if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) {
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ ERTS_BIF_PREP_RET(ret, am_false);
}
else {
erts_rwlock_old_code(code_ix);
@@ -990,8 +1118,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
/*
* Any code to purge?
*/
- if (modp->old.code == 0) {
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ if (!modp->old.code_hdr) {
+ ERTS_BIF_PREP_RET(ret, am_false);
}
else {
/*
@@ -1013,14 +1141,17 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
*/
ASSERT(erts_total_code_size >= modp->old.code_length);
erts_total_code_size -= modp->old.code_length;
- code = modp->old.code;
+ code = (BeamInstr*) modp->old.code_hdr;
end = (BeamInstr *)((char *)code + modp->old.code_length);
erts_cleanup_funs_on_purge(code, end);
beam_catches_delmod(modp->old.catches, code, modp->old.code_length,
code_ix);
- decrement_refc(code);
+ decrement_refc(modp->old.code_hdr);
+ if (modp->old.code_hdr->literals_start) {
+ erts_free(ERTS_ALC_T_LITERAL, modp->old.code_hdr->literals_start);
+ }
erts_free(ERTS_ALC_T_CODE, (void *) code);
- modp->old.code = NULL;
+ modp->old.code_hdr = NULL;
modp->old.code_length = 0;
modp->old.catches = BEAM_CATCHES_NIL;
erts_remove_from_ranges(code);
@@ -1037,10 +1168,9 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
}
static void
-decrement_refc(BeamInstr* code)
+decrement_refc(BeamCodeHeader* code_hdr)
{
- struct erl_off_heap_header* oh =
- (struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP];
+ struct erl_off_heap_header* oh = code_hdr->literals_off_heap;
while (oh) {
Binary* bptr;
@@ -1089,7 +1219,7 @@ delete_code(Module* modp)
ASSERT(modp->curr.num_breakpoints == 0);
ASSERT(modp->curr.num_traced_exports == 0);
modp->old = modp->curr;
- modp->curr.code = NULL;
+ modp->curr.code_hdr = NULL;
modp->curr.code_length = 0;
modp->curr.catches = BEAM_CATCHES_NIL;
modp->curr.nif = NULL;
@@ -1106,9 +1236,9 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module)
* if not, delete old code; error if old code already exists.
*/
- if (modp->curr.code != NULL && modp->old.code != NULL) {
+ if (modp->curr.code_hdr && modp->old.code_hdr) {
return am_not_purged;
- } else if (modp->old.code == NULL) { /* Make the current version old. */
+ } else if (!modp->old.code_hdr) { /* Make the current version old. */
delete_code(modp);
}
return NIL;
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index 9860968687..5d471d168b 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -154,8 +154,8 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
num_modules = 0;
for (current = 0; current < max_modules; current++) {
modp = module_code(current, code_ix);
- if (modp->curr.code) {
- max_funcs += modp->curr.code[MI_NUM_FUNCTIONS];
+ if (modp->curr.code_hdr) {
+ max_funcs += modp->curr.code_hdr->num_functions;
module[num_modules++] = modp;
}
}
@@ -163,9 +163,9 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
f->matching = (BpFunction *) Alloc(max_funcs*sizeof(BpFunction));
i = 0;
for (current = 0; current < num_modules; current++) {
- BeamInstr** code_base = (BeamInstr **) module[current]->curr.code;
+ BeamCodeHeader* code_hdr = module[current]->curr.code_hdr;
BeamInstr* code;
- Uint num_functions = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS];
+ Uint num_functions = (Uint)(UWord) code_hdr->num_functions;
Uint fi;
if (specified > 0) {
@@ -179,7 +179,7 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
BeamInstr* pc;
int wi;
- code = code_base[MI_FUNCTIONS+fi];
+ code = code_hdr->functions[fi];
ASSERT(code[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
pc = code+5;
if (erts_is_native_break(pc)) {
@@ -549,21 +549,21 @@ erts_clear_all_breaks(BpFunctions* f)
int
erts_clear_module_break(Module *modp) {
- BeamInstr** code_base;
+ BeamCodeHeader* code_hdr;
Uint n;
Uint i;
ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
ASSERT(modp);
- code_base = (BeamInstr **) modp->curr.code;
- if (code_base == NULL) {
+ code_hdr = modp->curr.code_hdr;
+ if (!code_hdr) {
return 0;
}
- n = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS];
+ n = (Uint)(UWord) code_hdr->num_functions;
for (i = 0; i < n; ++i) {
BeamInstr* pc;
- pc = code_base[MI_FUNCTIONS+i] + 5;
+ pc = code_hdr->functions[i] + 5;
if (erts_is_native_break(pc)) {
continue;
}
@@ -575,7 +575,7 @@ erts_clear_module_break(Module *modp) {
for (i = 0; i < n; ++i) {
BeamInstr* pc;
- pc = code_base[MI_FUNCTIONS+i] + 5;
+ pc = code_hdr->functions[i] + 5;
if (erts_is_native_break(pc)) {
continue;
}
@@ -864,7 +864,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg,
Eterm* cpp;
int return_to_trace = 0;
BeamInstr w;
- BeamInstr *cp_save;
+ BeamInstr *cp_save = c_p->cp;
Uint32 flags;
Uint need = 0;
Eterm* E = c_p->stop;
@@ -1205,17 +1205,17 @@ int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *retval) {
BeamInstr *
erts_find_local_func(Eterm mfa[3]) {
Module *modp;
- BeamInstr** code_base;
+ BeamCodeHeader* code_hdr;
BeamInstr* code_ptr;
Uint i,n;
if ((modp = erts_get_module(mfa[0], erts_active_code_ix())) == NULL)
return NULL;
- if ((code_base = (BeamInstr **) modp->curr.code) == NULL)
+ if ((code_hdr = modp->curr.code_hdr) == NULL)
return NULL;
- n = (BeamInstr) code_base[MI_NUM_FUNCTIONS];
+ n = (BeamInstr) code_hdr->num_functions;
for (i = 0; i < n; ++i) {
- code_ptr = code_base[MI_FUNCTIONS+i];
+ code_ptr = code_hdr->functions[i];
ASSERT(((BeamInstr) BeamOp(op_i_func_info_IaaI)) == code_ptr[0]);
ASSERT(mfa[0] == ((Eterm) code_ptr[2]) ||
is_nil((Eterm) code_ptr[2]));
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 90985e4f53..e37bd4d78c 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -73,6 +73,40 @@ erts_debug_flat_size_1(BIF_ALIST_1)
}
}
+BIF_RETTYPE
+erts_debug_size_shared_1(BIF_ALIST_1)
+{
+ Process* p = BIF_P;
+ Eterm term = BIF_ARG_1;
+ Uint size = size_shared(term);
+
+ if (IS_USMALL(0, size)) {
+ BIF_RET(make_small(size));
+ } else {
+ Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE);
+ BIF_RET(uint_to_big(size, hp));
+ }
+}
+
+BIF_RETTYPE
+erts_debug_copy_shared_1(BIF_ALIST_1)
+{
+ Process* p = BIF_P;
+ Eterm term = BIF_ARG_1;
+ Uint size;
+ Eterm* hp;
+ Eterm copy;
+ erts_shcopy_t info;
+ INITIALIZE_SHCOPY(info);
+
+ size = copy_shared_calculate(term, &info);
+ if (size > 0) {
+ hp = HAlloc(p, size);
+ }
+ copy = copy_shared_perform(term, size, &info, &hp, &p->off_heap);
+ DESTROY_SHCOPY(info);
+ BIF_RET(copy);
+}
BIF_RETTYPE
erts_debug_breakpoint_2(BIF_ALIST_2)
@@ -208,7 +242,7 @@ erts_debug_disassemble_1(BIF_ALIST_1)
Eterm bin;
Eterm mfa;
BeamInstr* funcinfo = NULL; /* Initialized to eliminate warning. */
- BeamInstr* code_base;
+ BeamCodeHeader* code_hdr;
BeamInstr* code_ptr = NULL; /* Initialized to eliminate warning. */
BeamInstr instr;
BeamInstr uaddr;
@@ -258,12 +292,12 @@ erts_debug_disassemble_1(BIF_ALIST_1)
*/
code_ptr = ((BeamInstr *) ep->addressv[code_ix]) - 5;
funcinfo = code_ptr+2;
- } else if (modp == NULL || (code_base = modp->curr.code) == NULL) {
+ } else if (modp == NULL || (code_hdr = modp->curr.code_hdr) == NULL) {
BIF_RET(am_undef);
} else {
- n = code_base[MI_NUM_FUNCTIONS];
+ n = code_hdr->num_functions;
for (i = 0; i < n; i++) {
- code_ptr = (BeamInstr *) code_base[MI_FUNCTIONS+i];
+ code_ptr = code_hdr->functions[i];
if (code_ptr[3] == name && code_ptr[4] == arity) {
funcinfo = code_ptr+2;
break;
@@ -432,39 +466,33 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
while (*sign) {
switch (*sign) {
case 'r': /* x(0) */
- erts_print(to, to_arg, "x(0)");
+ erts_print(to, to_arg, "r(0)");
break;
case 'x': /* x(N) */
- if (reg_index(ap[0]) == 0) {
- erts_print(to, to_arg, "x[0]");
- } else {
- erts_print(to, to_arg, "x(%d)", reg_index(ap[0]));
+ {
+ Uint n = ap[0] / sizeof(Eterm);
+ erts_print(to, to_arg, "x(%d)", n);
+ ap++;
}
- ap++;
break;
case 'y': /* y(N) */
- erts_print(to, to_arg, "y(%d)", reg_index(ap[0]) - CP_SIZE);
- ap++;
+ {
+ Uint n = ap[0] / sizeof(Eterm) - CP_SIZE;
+ erts_print(to, to_arg, "y(%d)", n);
+ ap++;
+ }
break;
case 'n': /* Nil */
erts_print(to, to_arg, "[]");
break;
case 's': /* Any source (tagged constant or register) */
- tag = beam_reg_tag(*ap);
- if (tag == X_REG_DEF) {
- if (reg_index(*ap) == 0) {
- erts_print(to, to_arg, "x[0]");
- } else {
- erts_print(to, to_arg, "x(%d)", reg_index(*ap));
- }
- ap++;
- break;
- } else if (tag == Y_REG_DEF) {
- erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE);
+ tag = loader_tag(*ap);
+ if (tag == LOADER_X_REG) {
+ erts_print(to, to_arg, "x(%d)", loader_x_reg_index(*ap));
ap++;
break;
- } else if (tag == R_REG_DEF) {
- erts_print(to, to_arg, "x(0)");
+ } else if (tag == LOADER_Y_REG) {
+ erts_print(to, to_arg, "y(%d)", loader_y_reg_index(*ap) - CP_SIZE);
ap++;
break;
}
@@ -481,20 +509,12 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
ap++;
break;
case 'd': /* Destination (x(0), x(N), y(N)) */
- switch (beam_reg_tag(*ap)) {
- case X_REG_DEF:
- if (reg_index(*ap) == 0) {
- erts_print(to, to_arg, "x[0]");
- } else {
- erts_print(to, to_arg, "x(%d)", reg_index(*ap));
- }
- break;
- case Y_REG_DEF:
- erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE);
- break;
- case R_REG_DEF:
- erts_print(to, to_arg, "x(0)");
- break;
+ if (*ap & 1) {
+ erts_print(to, to_arg, "y(%d)",
+ *ap / sizeof(Eterm) - CP_SIZE);
+ } else {
+ erts_print(to, to_arg, "x(%d)",
+ *ap / sizeof(Eterm));
}
ap++;
break;
@@ -561,7 +581,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
ap++;
break;
case 'l': /* fr(N) */
- erts_print(to, to_arg, "fr(%d)", reg_index(ap[0]));
+ erts_print(to, to_arg, "fr(%d)", loader_reg_index(ap[0]));
ap++;
break;
default:
@@ -580,7 +600,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
unpacked = ap;
ap = addr + size;
switch (op) {
- case op_i_select_val_lins_rfI:
case op_i_select_val_lins_xfI:
case op_i_select_val_lins_yfI:
{
@@ -600,7 +619,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_select_val_bins_rfI:
case op_i_select_val_bins_xfI:
case op_i_select_val_bins_yfI:
{
@@ -614,7 +632,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_select_tuple_arity_rfI:
case op_i_select_tuple_arity_xfI:
case op_i_select_tuple_arity_yfI:
{
@@ -639,7 +656,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_jump_on_val_rfII:
case op_i_jump_on_val_xfII:
case op_i_jump_on_val_yfII:
{
@@ -651,7 +667,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_jump_on_val_zero_rfI:
case op_i_jump_on_val_zero_xfI:
case op_i_jump_on_val_zero_yfI:
{
@@ -663,7 +678,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_put_tuple_rI:
case op_i_put_tuple_xI:
case op_i_put_tuple_yI:
case op_new_map_dII:
@@ -673,20 +687,16 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
int n = unpacked[-1];
while (n > 0) {
- if (!is_header(ap[0])) {
+ switch (loader_tag(ap[0])) {
+ case LOADER_X_REG:
+ erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0]));
+ break;
+ case LOADER_Y_REG:
+ erts_print(to, to_arg, " x(%d)", loader_y_reg_index(ap[0]));
+ break;
+ default:
erts_print(to, to_arg, " %T", (Eterm) ap[0]);
- } else {
- switch ((ap[0] >> 2) & 0x03) {
- case R_REG_DEF:
- erts_print(to, to_arg, " x(0)");
- break;
- case X_REG_DEF:
- erts_print(to, to_arg, " x(%d)", ap[0] >> 4);
- break;
- case Y_REG_DEF:
- erts_print(to, to_arg, " y(%d)", ap[0] >> 4);
- break;
- }
+ break;
}
ap++, size++, n--;
}
@@ -699,18 +709,16 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
while (n > 0) {
if (n % 3 == 1) {
erts_print(to, to_arg, " %X", ap[0]);
- } else if (!is_header(ap[0])) {
- erts_print(to, to_arg, " %T", (Eterm) ap[0]);
} else {
- switch ((ap[0] >> 2) & 0x03) {
- case R_REG_DEF:
- erts_print(to, to_arg, " x(0)");
+ switch (loader_tag(ap[0])) {
+ case LOADER_X_REG:
+ erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0]));
break;
- case X_REG_DEF:
- erts_print(to, to_arg, " x(%d)", ap[0] >> 4);
+ case LOADER_Y_REG:
+ erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]));
break;
- case Y_REG_DEF:
- erts_print(to, to_arg, " y(%d)", ap[0] >> 4);
+ default:
+ erts_print(to, to_arg, " %T", (Eterm) ap[0]);
break;
}
}
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 73292885ce..10f132abfc 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -99,10 +99,7 @@ do { \
do { \
int i_; \
int Arity_ = PC[-1]; \
- if (Arity_ > 0) { \
- CHECK_TERM(r(0)); \
- } \
- for (i_ = 1; i_ < Arity_; i_++) { \
+ for (i_ = 0; i_ < Arity_; i_++) { \
CHECK_TERM(x(i_)); \
} \
} while (0)
@@ -116,6 +113,9 @@ do { \
#define MAX(x, y) (((x) > (y)) ? (x) : (y))
#endif
+#define GET_BIF_MODULE(p) ((Eterm) (((Export *) p)->code[0]))
+#define GET_BIF_FUNCTION(p) ((Eterm) (((Export *) p)->code[1]))
+#define GET_BIF_ARITY(p) ((Eterm) (((Export *) p)->code[2]))
#define GET_BIF_ADDRESS(p) ((BifFunction) (((Export *) p)->code[4]))
#define TermWords(t) (((t) / (sizeof(BeamInstr)/sizeof(Eterm))) + !!((t) % (sizeof(BeamInstr)/sizeof(Eterm))))
@@ -151,25 +151,21 @@ do { \
ASSERT(VALID_INSTR(* (Eterm *)(ip))); \
I = (ip)
-#define FetchArgs(S1, S2) tmp_arg1 = (S1); tmp_arg2 = (S2)
+/*
+ * Register target (X or Y register).
+ */
+#define REG_TARGET(Target) (*(((Target) & 1) ? &yb(Target-1) : &xb(Target)))
/*
* Store a result into a register given a destination descriptor.
*/
-#define StoreResult(Result, DestDesc) \
- do { \
- Eterm stb_reg; \
- stb_reg = (DestDesc); \
- CHECK_TERM(Result); \
- switch (beam_reg_tag(stb_reg)) { \
- case R_REG_DEF: \
- r(0) = (Result); break; \
- case X_REG_DEF: \
- xb(x_reg_offset(stb_reg)) = (Result); break; \
- default: \
- yb(y_reg_offset(stb_reg)) = (Result); break; \
- } \
+#define StoreResult(Result, DestDesc) \
+ do { \
+ Eterm stb_reg; \
+ stb_reg = (DestDesc); \
+ CHECK_TERM(Result); \
+ REG_TARGET(stb_reg) = (Result); \
} while (0)
#define StoreSimpleDest(Src, Dest) Dest = (Src)
@@ -180,22 +176,16 @@ do { \
* be just before the next instruction.
*/
-#define StoreBifResult(Dst, Result) \
- do { \
- BeamInstr* stb_next; \
- Eterm stb_reg; \
- stb_reg = Arg(Dst); \
- I += (Dst) + 2; \
- stb_next = (BeamInstr *) *I; \
- CHECK_TERM(Result); \
- switch (beam_reg_tag(stb_reg)) { \
- case R_REG_DEF: \
- r(0) = (Result); Goto(stb_next); \
- case X_REG_DEF: \
- xb(x_reg_offset(stb_reg)) = (Result); Goto(stb_next); \
- default: \
- yb(y_reg_offset(stb_reg)) = (Result); Goto(stb_next); \
- } \
+#define StoreBifResult(Dst, Result) \
+ do { \
+ BeamInstr* stb_next; \
+ Eterm stb_reg; \
+ stb_reg = Arg(Dst); \
+ I += (Dst) + 2; \
+ stb_next = (BeamInstr *) *I; \
+ CHECK_TERM(Result); \
+ REG_TARGET(stb_reg) = (Result); \
+ Goto(stb_next); \
} while (0)
#define ClauseFail() goto jump_f
@@ -250,6 +240,14 @@ void** beam_ops;
HEAP_TOP(c_p) = HTOP; \
c_p->stop = E
+#define HEAVY_SWAPIN \
+ SWAPIN; \
+ FCALLS = c_p->fcalls
+
+#define HEAVY_SWAPOUT \
+ SWAPOUT; \
+ c_p->fcalls = FCALLS
+
/*
* Use LIGHT_SWAPOUT when the called function
* will call HeapOnlyAlloc() (and never HAlloc()).
@@ -293,7 +291,7 @@ void** beam_ops;
#define Ib(N) (N)
#define x(N) reg[N]
#define y(N) E[N]
-#define r(N) x##N
+#define r(N) x(N)
/*
* Makes sure that there are StackNeed + HeapNeed + 1 words available
@@ -309,12 +307,10 @@ void** beam_ops;
needed = (StackNeed) + 1; \
if (E - HTOP < (needed + (HeapNeed))) { \
SWAPOUT; \
- reg[0] = r(0); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect(c_p, needed + (HeapNeed), reg, (M)); \
+ FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), reg, (M)); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- r(0) = reg[0]; \
SWAPIN; \
} \
E -= needed; \
@@ -363,12 +359,10 @@ void** beam_ops;
unsigned need = (Nh); \
if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\
SWAPOUT; \
- reg[0] = r(0); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- r(0) = reg[0]; \
SWAPIN; \
} \
HEAP_SPACE_VERIFIED(need); \
@@ -386,12 +380,10 @@ void** beam_ops;
unsigned need = (Nh); \
if (E - HTOP < need) { \
SWAPOUT; \
- reg[0] = r(0); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live));\
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- r(0) = reg[0]; \
SWAPIN; \
} \
HEAP_SPACE_VERIFIED(need); \
@@ -408,15 +400,11 @@ void** beam_ops;
unsigned need = (Nh); \
if (E - HTOP < need) { \
SWAPOUT; \
- reg[0] = r(0); \
reg[Live] = Extra; \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)+1); \
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- if (Live > 0) { \
- r(0) = reg[0]; \
- } \
Extra = reg[Live]; \
SWAPIN; \
} \
@@ -438,10 +426,9 @@ void** beam_ops;
#define MakeFun(FunP, NumFree) \
do { \
- SWAPOUT; \
- reg[0] = r(0); \
+ HEAVY_SWAPOUT; \
r(0) = new_fun(c_p, reg, (ErlFunEntry *) FunP, NumFree); \
- SWAPIN; \
+ HEAVY_SWAPIN; \
} while (0)
#define PutTuple(Dst, Arity) \
@@ -531,15 +518,19 @@ void** beam_ops;
ASSERT(VALID_INSTR(Dst)); \
Goto(Dst)
-#define GetR(pos, tr) \
- do { \
- tr = Arg(pos); \
- switch (beam_reg_tag(tr)) { \
- case R_REG_DEF: tr = r(0); break; \
- case X_REG_DEF: tr = xb(x_reg_offset(tr)); break; \
- case Y_REG_DEF: ASSERT(y_reg_offset(tr) >= 1); tr = yb(y_reg_offset(tr)); break; \
- } \
- CHECK_TERM(tr); \
+#define GetR(pos, tr) \
+ do { \
+ tr = Arg(pos); \
+ switch (loader_tag(tr)) { \
+ case LOADER_X_REG: \
+ tr = x(loader_x_reg_index(tr)); \
+ break; \
+ case LOADER_Y_REG: \
+ ASSERT(loader_y_reg_index(tr) >= 1); \
+ tr = y(loader_y_reg_index(tr)); \
+ break; \
+ } \
+ CHECK_TERM(tr); \
} while (0)
#define GetArg1(N, Dst) GetR((N), Dst)
@@ -557,24 +548,93 @@ void** beam_ops;
HTOP += 2; \
} while (0)
+#define Swap(R1, R2) \
+ do { \
+ Eterm V = R1; \
+ R1 = R2; \
+ R2 = V; \
+ } while (0)
+
+#define SwapTemp(R1, R2, Tmp) \
+ do { \
+ Eterm V = R1; \
+ R1 = R2; \
+ R2 = Tmp = V; \
+ } while (0)
+
#define Move(Src, Dst, Store) \
do { \
Eterm term = (Src); \
Store(term, Dst); \
} while (0)
-#define Move2(S1, D1, S2, D2) D1 = (S1); D2 = (S2)
+#define Move2Par(S1, D1, S2, D2) \
+ do { \
+ Eterm V1, V2; \
+ V1 = (S1); V2 = (S2); D1 = V1; D2 = V2; \
+ } while (0)
+
+#define MoveShift(Src, SD, D) \
+ do { \
+ Eterm V; \
+ V = Src; D = SD; SD = V; \
+ } while (0)
+
+#define MoveDup(Src, D1, D2) \
+ do { \
+ D1 = D2 = (Src); \
+ } while (0)
+
#define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3)
-#define MoveGenDest(src, dstp) \
- if ((dstp) == NULL) { r(0) = (src); } else { *(dstp) = src; }
+#define MoveWindow3(S1, S2, S3, D) \
+ do { \
+ Eterm xt0, xt1, xt2; \
+ Eterm *y = &D; \
+ xt0 = S1; \
+ xt1 = S2; \
+ xt2 = S3; \
+ y[0] = xt0; \
+ y[1] = xt1; \
+ y[2] = xt2; \
+ } while (0)
+
+#define MoveWindow4(S1, S2, S3, S4, D) \
+ do { \
+ Eterm xt0, xt1, xt2, xt3; \
+ Eterm *y = &D; \
+ xt0 = S1; \
+ xt1 = S2; \
+ xt2 = S3; \
+ xt3 = S4; \
+ y[0] = xt0; \
+ y[1] = xt1; \
+ y[2] = xt2; \
+ y[3] = xt3; \
+ } while (0)
+
+#define MoveWindow5(S1, S2, S3, S4, S5, D) \
+ do { \
+ Eterm xt0, xt1, xt2, xt3, xt4; \
+ Eterm *y = &D; \
+ xt0 = S1; \
+ xt1 = S2; \
+ xt2 = S3; \
+ xt3 = S4; \
+ xt4 = S5; \
+ y[0] = xt0; \
+ y[1] = xt1; \
+ y[2] = xt2; \
+ y[3] = xt3; \
+ y[4] = xt4; \
+ } while (0)
-#define MoveReturn(Src, Dest) \
- (Dest) = (Src); \
- I = c_p->cp; \
- ASSERT(VALID_INSTR(*c_p->cp)); \
- c_p->cp = 0; \
- CHECK_TERM(r(0)); \
+#define MoveReturn(Src) \
+ x(0) = (Src); \
+ I = c_p->cp; \
+ ASSERT(VALID_INSTR(*c_p->cp)); \
+ c_p->cp = 0; \
+ CHECK_TERM(r(0)); \
Goto(*I)
#define DeallocateReturn(Deallocate) \
@@ -586,26 +646,26 @@ void** beam_ops;
Goto(*I); \
} while (0)
-#define MoveDeallocateReturn(Src, Dest, Deallocate) \
- (Dest) = (Src); \
+#define MoveDeallocateReturn(Src, Deallocate) \
+ x(0) = (Src); \
DeallocateReturn(Deallocate)
-#define MoveCall(Src, Dest, CallDest, Size) \
- (Dest) = (Src); \
+#define MoveCall(Src, CallDest, Size) \
+ x(0) = (Src); \
SET_CP(c_p, I+Size+1); \
- SET_I((BeamInstr *) CallDest); \
+ SET_I((BeamInstr *) CallDest); \
Dispatch();
-#define MoveCallLast(Src, Dest, CallDest, Deallocate) \
- (Dest) = (Src); \
- RESTORE_CP(E); \
- E = ADD_BYTE_OFFSET(E, (Deallocate)); \
- SET_I((BeamInstr *) CallDest); \
+#define MoveCallLast(Src, CallDest, Deallocate) \
+ x(0) = (Src); \
+ RESTORE_CP(E); \
+ E = ADD_BYTE_OFFSET(E, (Deallocate)); \
+ SET_I((BeamInstr *) CallDest); \
Dispatch();
-#define MoveCallOnly(Src, Dest, CallDest) \
- (Dest) = (Src); \
- SET_I((BeamInstr *) CallDest); \
+#define MoveCallOnly(Src, CallDest) \
+ x(0) = (Src); \
+ SET_I((BeamInstr *) CallDest); \
Dispatch();
#define MoveJump(Src) \
@@ -613,60 +673,58 @@ void** beam_ops;
SET_I((BeamInstr *) Arg(0)); \
Goto(*I);
-#define GetList(Src, H, T) do { \
- Eterm* tmp_ptr = list_val(Src); \
- H = CAR(tmp_ptr); \
- T = CDR(tmp_ptr); } while (0)
-
-#define GetTupleElement(Src, Element, Dest) \
- do { \
- tmp_arg1 = (Eterm) COMPRESS_POINTER(((unsigned char *) tuple_val(Src)) + \
- (Element)); \
- (Dest) = (*(Eterm *) EXPAND_POINTER(tmp_arg1)); \
- } while (0)
-
-#define ExtractNextElement(Dest) \
- tmp_arg1 += sizeof(Eterm); \
- (Dest) = (* (Eterm *) (((unsigned char *) EXPAND_POINTER(tmp_arg1))))
-
-#define ExtractNextElement2(Dest) \
- do { \
- Eterm* ene_dstp = &(Dest); \
- ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \
- ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \
- tmp_arg1 += sizeof(Eterm) + sizeof(Eterm); \
+#define GetList(Src, H, T) \
+ do { \
+ Eterm* tmp_ptr = list_val(Src); \
+ Eterm hd, tl; \
+ hd = CAR(tmp_ptr); \
+ tl = CDR(tmp_ptr); \
+ H = hd; T = tl; \
} while (0)
-#define ExtractNextElement3(Dest) \
- do { \
- Eterm* ene_dstp = &(Dest); \
- ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \
- ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \
- ene_dstp[2] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[3]; \
- tmp_arg1 += 3*sizeof(Eterm); \
+#define GetTupleElement(Src, Element, Dest) \
+ do { \
+ Eterm* src; \
+ src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
+ (Dest) = *src; \
} while (0)
-#define ExtractNextElement4(Dest) \
- do { \
- Eterm* ene_dstp = &(Dest); \
- ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \
- ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \
- ene_dstp[2] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[3]; \
- ene_dstp[3] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[4]; \
- tmp_arg1 += 4*sizeof(Eterm); \
+#define GetTupleElement2(Src, Element, Dest) \
+ do { \
+ Eterm* src; \
+ Eterm* dst; \
+ Eterm E1, E2; \
+ src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
+ dst = &(Dest); \
+ E1 = src[0]; \
+ E2 = src[1]; \
+ dst[0] = E1; \
+ dst[1] = E2; \
} while (0)
-#define ExtractElement(Element, Dest) \
- do { \
- tmp_arg1 += (Element); \
- (Dest) = (* (Eterm *) EXPAND_POINTER(tmp_arg1)); \
+#define GetTupleElement3(Src, Element, Dest) \
+ do { \
+ Eterm* src; \
+ Eterm* dst; \
+ Eterm E1, E2, E3; \
+ src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
+ dst = &(Dest); \
+ E1 = src[0]; \
+ E2 = src[1]; \
+ E3 = src[2]; \
+ dst[0] = E1; \
+ dst[1] = E2; \
+ dst[2] = E3; \
} while (0)
#define EqualImmed(X, Y, Action) if (X != Y) { Action; }
#define NotEqualImmed(X, Y, Action) if (X == Y) { Action; }
#define EqualExact(X, Y, Action) if (!EQ(X,Y)) { Action; }
-#define IsLessThan(X, Y, Action) if (CMP_GE(X, Y)) { Action; }
-#define IsGreaterEqual(X, Y, Action) if (CMP_LT(X, Y)) { Action; }
+#define NotEqualExact(X, Y, Action) if (EQ(X,Y)) { Action; }
+#define Equal(X, Y, Action) CMP_EQ_ACTION(X,Y,Action)
+#define NotEqual(X, Y, Action) CMP_NE_ACTION(X,Y,Action)
+#define IsLessThan(X, Y, Action) CMP_LT_ACTION(X,Y,Action)
+#define IsGreaterEqual(X, Y, Action) CMP_GE_ACTION(X,Y,Action)
#define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; }
@@ -690,18 +748,26 @@ void** beam_ops;
if (is_not_list(Src)) { Fail; } \
A(Need, Alive)
-#define IsNonemptyListTestHeap(Src, Need, Alive, Fail) \
- if (is_not_list(Src)) { Fail; } \
+#define IsNonemptyListTestHeap(Need, Alive, Fail) \
+ if (is_not_list(x(0))) { Fail; } \
TestHeap(Need, Alive)
+#define IsNonemptyListGetList(Src, H, T, Fail) \
+ if (is_not_list(Src)) { \
+ Fail; \
+ } else { \
+ Eterm* tmp_ptr = list_val(Src); \
+ Eterm hd, tl; \
+ hd = CAR(tmp_ptr); \
+ tl = CDR(tmp_ptr); \
+ H = hd; T = tl; \
+ }
+
#define IsTuple(X, Action) if (is_not_tuple(X)) Action
-#define IsArity(Pointer, Arity, Fail) \
- if (*(Eterm *) \
- EXPAND_POINTER(tmp_arg1 = (Eterm) \
- COMPRESS_POINTER(tuple_val(Pointer))) != (Arity)) \
- { \
- Fail; \
+#define IsArity(Pointer, Arity, Fail) \
+ if (*tuple_val(Pointer) != (Arity)) { \
+ Fail; \
}
#define IsMap(Src, Fail) if (!is_map(Src)) { Fail; }
@@ -738,15 +804,21 @@ void** beam_ops;
} \
} while (0)
-#define IsTupleOfArity(Src, Arity, Fail) \
- do { \
- if (is_not_tuple(Src) || \
- *(Eterm *) \
- EXPAND_POINTER(tmp_arg1 = \
- (Eterm) COMPRESS_POINTER(tuple_val(Src))) != Arity) { \
- Fail; \
- } \
+#ifdef DEBUG
+#define IsTupleOfArity(Src, Arityval, Fail) \
+ do { \
+ if (!(is_tuple(Src) && *tuple_val(Src) == Arityval)) { \
+ Fail; \
+ } \
} while (0)
+#else
+#define IsTupleOfArity(Src, Arityval, Fail) \
+ do { \
+ if (!(is_boxed(Src) && *tuple_val(Src) == Arityval)) { \
+ Fail; \
+ } \
+ } while (0)
+#endif
#define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; }
@@ -756,7 +828,7 @@ void** beam_ops;
#define IsBitstring(Src, Fail) \
if (is_not_binary(Src)) { Fail; }
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define BsSafeMul(A, B, Fail, Target) \
do { Uint64 _res = (A) * (B); \
if (_res / B != A) { Fail; } \
@@ -773,6 +845,7 @@ void** beam_ops;
#define BsGetFieldSize(Bits, Unit, Fail, Target) \
do { \
Sint _signed_size; Uint _uint_size; \
+ Uint temp_bits; \
if (is_small(Bits)) { \
_signed_size = signed_val(Bits); \
if (_signed_size < 0) { Fail; } \
@@ -787,6 +860,7 @@ void** beam_ops;
#define BsGetUncheckedFieldSize(Bits, Unit, Fail, Target) \
do { \
Sint _signed_size; Uint _uint_size; \
+ Uint temp_bits; \
if (is_small(Bits)) { \
_signed_size = signed_val(Bits); \
if (_signed_size < 0) { Fail; } \
@@ -998,23 +1072,17 @@ init_emulator(void)
*/
#if defined(__GNUC__) && defined(sparc) && !defined(DEBUG)
-# define REG_x0 asm("%l0")
# define REG_xregs asm("%l1")
# define REG_htop asm("%l2")
# define REG_stop asm("%l3")
# define REG_I asm("%l4")
# define REG_fcalls asm("%l5")
-# define REG_tmp_arg1 asm("%l6")
-# define REG_tmp_arg2 asm("%l7")
#else
-# define REG_x0
# define REG_xregs
# define REG_htop
# define REG_stop
# define REG_I
# define REG_fcalls
-# define REG_tmp_arg1
-# define REG_tmp_arg2
#endif
#ifdef USE_VM_PROBES
@@ -1132,11 +1200,6 @@ void process_main(void)
ERTS_DECLARE_DUMMY(Eterm pid);
#endif
- /*
- * X register zero; also called r(0)
- */
- register Eterm x0 REG_x0 = NIL;
-
/* Pointer to X registers: x(1)..x(N); reg[0] is used when doing GC,
* in all other cases x0 is used.
*/
@@ -1164,17 +1227,6 @@ void process_main(void)
register Sint FCALLS REG_fcalls = 0;
/*
- * Temporaries used for picking up arguments for instructions.
- */
- register Eterm tmp_arg1 REG_tmp_arg1 = NIL;
- register Eterm tmp_arg2 REG_tmp_arg2 = NIL;
-#if HEAP_ON_C_STACK
- Eterm tmp_big[2]; /* Temporary buffer for small bignums if HEAP_ON_C_STACK. */
-#else
- Eterm *tmp_big; /* Temporary buffer for small bignums if !HEAP_ON_C_STACK. */
-#endif
-
- /*
* X registers and floating point registers are located in
* scheduler specific data.
*/
@@ -1185,8 +1237,6 @@ void process_main(void)
*/
int neg_o_reds = 0;
- Eterm (*arith_func)(Process* p, Eterm* reg, Uint live);
-
#ifdef ERTS_OPCODE_COUNTER_SUPPORT
static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES };
#else
@@ -1197,13 +1247,13 @@ void process_main(void)
#endif
#endif
- Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */
-
Eterm pt_arity; /* Used by do_put_tuple */
Uint64 start_time = 0; /* Monitor long schedule */
BeamInstr* start_time_i = NULL;
+ ERTS_MSACC_DECLARE_CACHE_X() /* a cached value of the tsd pointer for msacc */
+
ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */
@@ -1247,9 +1297,6 @@ void process_main(void)
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
-#if HALFWORD_HEAP
- ASSERT(erts_get_scheduler_data()->num_tmp_heap_used == 0);
-#endif
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
c_p = schedule(c_p, reds_used);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
@@ -1260,6 +1307,8 @@ void process_main(void)
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_MSACC_UPDATE_CACHE_X();
+
if (erts_system_monitor_long_schedule != 0) {
start_time = erts_timestamp_millis();
start_time_i = c_p->i;
@@ -1267,9 +1316,6 @@ void process_main(void)
reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
-#if !HEAP_ON_C_STACK
- tmp_big = ERTS_PROC_GET_SCHDATA(c_p)->beam_emu_tmp_heap;
-#endif
ERL_BITS_RELOAD_STATEP(c_p);
{
int reds;
@@ -1278,7 +1324,7 @@ void process_main(void)
int i;
argp = c_p->arg_reg;
- for (i = c_p->arity - 1; i > 0; i--) {
+ for (i = c_p->arity - 1; i >= 0; i--) {
reg[i] = argp[i];
CHECK_TERM(reg[i]);
}
@@ -1302,12 +1348,6 @@ void process_main(void)
}
next = (BeamInstr *) *I;
- r(0) = c_p->arg_reg[0];
-#ifdef HARDDEBUG
- if (c_p->arity > 0) {
- CHECK_TERM(r(0));
- }
-#endif
SWAPIN;
ASSERT(VALID_INSTR(next));
@@ -1346,26 +1386,24 @@ void process_main(void)
#endif
#include "beam_hot.h"
-#define STORE_ARITH_RESULT(res) StoreBifResult(2, (res));
-#define ARITH_FUNC(name) erts_gc_##name
-
{
Eterm increment_reg_val;
Eterm increment_val;
Uint live;
Eterm result;
- OpCase(i_increment_yIId):
- increment_reg_val = yb(Arg(0));
+ OpCase(i_increment_rIId):
+ increment_reg_val = x(0);
+ I--;
goto do_increment;
OpCase(i_increment_xIId):
increment_reg_val = xb(Arg(0));
goto do_increment;
- OpCase(i_increment_rIId):
- increment_reg_val = r(0);
- I--;
+ OpCase(i_increment_yIId):
+ increment_reg_val = yb(Arg(0));
+ goto do_increment;
do_increment:
increment_val = Arg(1);
@@ -1374,229 +1412,133 @@ void process_main(void)
ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
if (MY_IS_SSMALL(i)) {
result = make_small(i);
- store_result:
StoreBifResult(3, result);
}
}
live = Arg(2);
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
reg[live] = increment_reg_val;
reg[live+1] = make_small(increment_val);
result = erts_gc_mixed_plus(c_p, reg, live);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPIN;
ERTS_HOLE_CHECK(c_p);
if (is_value(result)) {
- goto store_result;
+ StoreBifResult(3, result);
}
ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue));
goto find_func_info;
}
-#define DO_BIG_ARITH(Func,Arg1,Arg2) \
- do { \
- Uint live = Arg(1); \
- SWAPOUT; \
- reg[0] = r(0); \
- reg[live] = (Arg1); \
- reg[live+1] = (Arg2); \
- result = (Func)(c_p, reg, live); \
- r(0) = reg[0]; \
- SWAPIN; \
- ERTS_HOLE_CHECK(c_p); \
- if (is_value(result)) { \
- StoreBifResult(4,result); \
- } \
- goto lb_Cl_error; \
- } while(0)
+#define DO_OUTLINED_ARITH_2(name, Op1, Op2) \
+ do { \
+ Eterm result; \
+ Uint live = Arg(1); \
+ \
+ HEAVY_SWAPOUT; \
+ reg[live] = Op1; \
+ reg[live+1] = Op2; \
+ result = erts_gc_##name(c_p, reg, live); \
+ HEAVY_SWAPIN; \
+ ERTS_HOLE_CHECK(c_p); \
+ if (is_value(result)) { \
+ StoreBifResult(4, result); \
+ } \
+ goto lb_Cl_error; \
+ } while (0)
- OpCase(i_plus_jIxxd):
{
+ Eterm PlusOp1, PlusOp2;
Eterm result;
- if (is_both_small(xb(Arg(2)), xb(Arg(3)))) {
- Sint i = signed_val(xb(Arg(2))) + signed_val(xb(Arg(3)));
+ OpCase(i_plus_jIxxd):
+ PlusOp1 = xb(Arg(2));
+ PlusOp2 = xb(Arg(3));
+ goto do_plus;
+
+ OpCase(i_plus_jIxyd):
+ PlusOp1 = xb(Arg(2));
+ PlusOp2 = yb(Arg(3));
+ goto do_plus;
+
+ OpCase(i_plus_jIssd):
+ GetArg2(2, PlusOp1, PlusOp2);
+ goto do_plus;
+
+ do_plus:
+ if (is_both_small(PlusOp1, PlusOp2)) {
+ Sint i = signed_val(PlusOp1) + signed_val(PlusOp2);
ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
if (MY_IS_SSMALL(i)) {
result = make_small(i);
StoreBifResult(4, result);
}
}
- DO_BIG_ARITH(ARITH_FUNC(mixed_plus), xb(Arg(2)), xb(Arg(3)));
+ DO_OUTLINED_ARITH_2(mixed_plus, PlusOp1, PlusOp2);
}
- OpCase(i_plus_jId):
{
+ Eterm MinusOp1, MinusOp2;
Eterm result;
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint i = signed_val(tmp_arg1) + signed_val(tmp_arg2);
- ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
- if (MY_IS_SSMALL(i)) {
- result = make_small(i);
- STORE_ARITH_RESULT(result);
- }
- }
- arith_func = ARITH_FUNC(mixed_plus);
- goto do_big_arith2;
- }
-
OpCase(i_minus_jIxxd):
- {
- Eterm result;
+ MinusOp1 = xb(Arg(2));
+ MinusOp2 = xb(Arg(3));
+ goto do_minus;
- if (is_both_small(xb(Arg(2)), xb(Arg(3)))) {
- Sint i = signed_val(xb(Arg(2))) - signed_val(xb(Arg(3)));
- ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
- if (MY_IS_SSMALL(i)) {
- result = make_small(i);
- StoreBifResult(4, result);
- }
- }
- DO_BIG_ARITH(ARITH_FUNC(mixed_minus), xb(Arg(2)), xb(Arg(3)));
- }
+ OpCase(i_minus_jIssd):
+ GetArg2(2, MinusOp1, MinusOp2);
+ goto do_minus;
- OpCase(i_minus_jId):
- {
- Eterm result;
-
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint i = signed_val(tmp_arg1) - signed_val(tmp_arg2);
+ do_minus:
+ if (is_both_small(MinusOp1, MinusOp2)) {
+ Sint i = signed_val(MinusOp1) - signed_val(MinusOp2);
ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
if (MY_IS_SSMALL(i)) {
result = make_small(i);
- STORE_ARITH_RESULT(result);
+ StoreBifResult(4, result);
}
}
- arith_func = ARITH_FUNC(mixed_minus);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(mixed_minus, MinusOp1, MinusOp2);
}
- OpCase(i_is_lt_f):
- if (CMP_GE(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
- OpCase(i_is_ge_f):
- if (CMP_LT(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
- OpCase(i_is_eq_f):
- if (CMP_NE(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
- OpCase(i_is_ne_f):
- if (CMP_EQ(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
- OpCase(i_is_eq_exact_f):
- if (!EQ(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
{
Eterm is_eq_exact_lit_val;
- OpCase(i_is_eq_exact_literal_xfc):
- is_eq_exact_lit_val = xb(Arg(0));
- I++;
+ OpCase(i_is_eq_exact_literal_fxc):
+ is_eq_exact_lit_val = xb(Arg(1));
goto do_is_eq_exact_literal;
- OpCase(i_is_eq_exact_literal_yfc):
- is_eq_exact_lit_val = yb(Arg(0));
- I++;
+ OpCase(i_is_eq_exact_literal_fyc):
+ is_eq_exact_lit_val = yb(Arg(1));
goto do_is_eq_exact_literal;
- OpCase(i_is_eq_exact_literal_rfc):
- is_eq_exact_lit_val = r(0);
-
do_is_eq_exact_literal:
- if (!eq(Arg(1), is_eq_exact_lit_val)) {
+ if (!eq(Arg(2), is_eq_exact_lit_val)) {
ClauseFail();
}
- Next(2);
+ Next(3);
}
{
Eterm is_ne_exact_lit_val;
- OpCase(i_is_ne_exact_literal_xfc):
- is_ne_exact_lit_val = xb(Arg(0));
- I++;
+ OpCase(i_is_ne_exact_literal_fxc):
+ is_ne_exact_lit_val = xb(Arg(1));
goto do_is_ne_exact_literal;
- OpCase(i_is_ne_exact_literal_yfc):
- is_ne_exact_lit_val = yb(Arg(0));
- I++;
+ OpCase(i_is_ne_exact_literal_fyc):
+ is_ne_exact_lit_val = yb(Arg(1));
goto do_is_ne_exact_literal;
- OpCase(i_is_ne_exact_literal_rfc):
- is_ne_exact_lit_val = r(0);
-
do_is_ne_exact_literal:
- if (eq(Arg(1), is_ne_exact_lit_val)) {
+ if (eq(Arg(2), is_ne_exact_lit_val)) {
ClauseFail();
}
- Next(2);
+ Next(3);
}
- OpCase(move_window3_xxxy): {
- BeamInstr *next;
- Eterm xt0, xt1, xt2;
- Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(3)));
- PreFetch(4, next);
- xt0 = xb(Arg(0));
- xt1 = xb(Arg(1));
- xt2 = xb(Arg(2));
- y[0] = xt0;
- y[1] = xt1;
- y[2] = xt2;
- NextPF(4, next);
- }
- OpCase(move_window4_xxxxy): {
- BeamInstr *next;
- Eterm xt0, xt1, xt2, xt3;
- Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(4)));
- PreFetch(5, next);
- xt0 = xb(Arg(0));
- xt1 = xb(Arg(1));
- xt2 = xb(Arg(2));
- xt3 = xb(Arg(3));
- y[0] = xt0;
- y[1] = xt1;
- y[2] = xt2;
- y[3] = xt3;
- NextPF(5, next);
- }
- OpCase(move_window5_xxxxxy): {
- BeamInstr *next;
- Eterm xt0, xt1, xt2, xt3, xt4;
- Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(5)));
- PreFetch(6, next);
- xt0 = xb(Arg(0));
- xt1 = xb(Arg(1));
- xt2 = xb(Arg(2));
- xt3 = xb(Arg(3));
- xt4 = xb(Arg(4));
- y[0] = xt0;
- y[1] = xt1;
- y[2] = xt2;
- y[3] = xt3;
- y[4] = xt4;
- NextPF(6, next);
- }
-
- OpCase(i_move_call_only_fcr): {
+ OpCase(i_move_call_only_fc): {
r(0) = Arg(1);
}
/* FALL THROUGH */
@@ -1606,7 +1548,7 @@ void process_main(void)
Dispatch();
}
- OpCase(i_move_call_last_fPcr): {
+ OpCase(i_move_call_last_fPc): {
r(0) = Arg(2);
}
/* FALL THROUGH */
@@ -1618,7 +1560,7 @@ void process_main(void)
Dispatch();
}
- OpCase(i_move_call_crf): {
+ OpCase(i_move_call_cf): {
r(0) = Arg(0);
I++;
}
@@ -1630,7 +1572,7 @@ void process_main(void)
Dispatch();
}
- OpCase(i_move_call_ext_last_ePcr): {
+ OpCase(i_move_call_ext_last_ePc): {
r(0) = Arg(2);
}
/* FALL THROUGH */
@@ -1646,7 +1588,7 @@ void process_main(void)
DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0));
Dispatchx();
- OpCase(i_move_call_ext_cre): {
+ OpCase(i_move_call_ext_ce): {
r(0) = Arg(0);
I++;
}
@@ -1656,7 +1598,7 @@ void process_main(void)
DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0));
Dispatchx();
- OpCase(i_move_call_ext_only_ecr): {
+ OpCase(i_move_call_ext_only_ec): {
r(0) = Arg(1);
}
/* FALL THROUGH */
@@ -1722,17 +1664,11 @@ void process_main(void)
PRE_BIF_SWAPOUT(c_p);
c_p->fcalls = FCALLS - 1;
- reg[0] = r(0);
result = erl_send(c_p, r(0), x(1));
PreFetch(0, next);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
- if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) {
- result = erts_gc_after_bif_call(c_p, result, reg, 2);
- r(0) = reg[0];
- E = c_p->stop;
- }
HTOP = HEAP_TOP(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
@@ -1743,7 +1679,6 @@ void process_main(void)
SET_CP(c_p, I+1);
SET_I(c_p->i);
SWAPIN;
- r(0) = reg[0];
Dispatch();
}
goto find_func_info;
@@ -1753,29 +1688,23 @@ void process_main(void)
Eterm element_index;
Eterm element_tuple;
- OpCase(i_element_xjsd):
- element_tuple = xb(Arg(0));
- I++;
+ OpCase(i_element_jxsd):
+ element_tuple = xb(Arg(1));
goto do_element;
- OpCase(i_element_yjsd):
- element_tuple = yb(Arg(0));
- I++;
+ OpCase(i_element_jysd):
+ element_tuple = yb(Arg(1));
goto do_element;
- OpCase(i_element_rjsd):
- element_tuple = r(0);
- /* Fall through */
-
do_element:
- GetArg1(1, element_index);
+ GetArg1(2, element_index);
if (is_small(element_index) && is_tuple(element_tuple)) {
Eterm* tp = tuple_val(element_tuple);
if ((signed_val(element_index) >= 1) &&
(signed_val(element_index) <= arityval(*tp))) {
Eterm result = tp[signed_val(element_index)];
- StoreBifResult(2, result);
+ StoreBifResult(3, result);
}
}
}
@@ -1789,29 +1718,24 @@ void process_main(void)
{
Eterm fast_element_tuple;
- OpCase(i_fast_element_rjId):
- fast_element_tuple = r(0);
+ OpCase(i_fast_element_jxId):
+ fast_element_tuple = xb(Arg(1));
+ goto do_fast_element;
+
+ OpCase(i_fast_element_jyId):
+ fast_element_tuple = yb(Arg(1));
+ goto do_fast_element;
do_fast_element:
if (is_tuple(fast_element_tuple)) {
Eterm* tp = tuple_val(fast_element_tuple);
- Eterm pos = Arg(1); /* Untagged integer >= 1 */
+ Eterm pos = Arg(2); /* Untagged integer >= 1 */
if (pos <= arityval(*tp)) {
Eterm result = tp[pos];
- StoreBifResult(2, result);
+ StoreBifResult(3, result);
}
}
goto badarg;
-
- OpCase(i_fast_element_xjId):
- fast_element_tuple = xb(Arg(0));
- I++;
- goto do_fast_element;
-
- OpCase(i_fast_element_yjId):
- fast_element_tuple = yb(Arg(0));
- I++;
- goto do_fast_element;
}
OpCase(catch_yf):
@@ -1832,11 +1756,10 @@ void process_main(void)
SWAPIN;
}
/* only x(2) is included in the rootset here */
- if (E - HTOP < 3 || c_p->mbuf) { /* Force GC in case add_stacktrace()
- * created heap fragments */
+ if (E - HTOP < 3) {
SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
- FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1);
+ FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
SWAPIN;
@@ -1917,13 +1840,20 @@ void process_main(void)
* Pick up the next message and place it in x(0).
* If no message, jump to a wait or wait_timeout instruction.
*/
- OpCase(i_loop_rec_fr):
+ OpCase(i_loop_rec_f):
{
BeamInstr *next;
- ErlMessage* msgp;
+ ErtsMessage* msgp;
- loop_rec__:
+ /*
+ * We need to disable GC while matching messages
+ * in the queue. This since messages with data outside
+ * the heap will be corrupted by a GC.
+ */
+ ASSERT(!(c_p->flags & F_DELAY_GC));
+ c_p->flags |= F_DELAY_GC;
+ loop_rec__:
PROCESS_MAIN_CHK_LOCKS(c_p);
msgp = PEEK_MESSAGE(c_p);
@@ -1935,6 +1865,7 @@ void process_main(void)
if (ERTS_PROC_PENDING_EXIT(c_p)) {
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
SWAPOUT;
+ c_p->flags &= ~F_DELAY_GC;
goto do_schedule; /* Will be rescheduled for exit */
}
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
@@ -1944,32 +1875,27 @@ void process_main(void)
else
#endif
{
+ c_p->flags &= ~F_DELAY_GC;
SET_I((BeamInstr *) Arg(0));
Goto(*I); /* Jump to a wait or wait_timeout instruction */
}
}
- ErtsMoveMsgAttachmentIntoProc(msgp, c_p, E, HTOP, FCALLS,
- {
- SWAPOUT;
- reg[0] = r(0);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- },
- {
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- r(0) = reg[0];
- SWAPIN;
- });
if (is_non_value(ERL_MESSAGE_TERM(msgp))) {
- /*
- * A corrupt distribution message that we weren't able to decode;
- * remove it...
- */
- ASSERT(!msgp->data.attached);
- /* TODO: Add DTrace probe for this bad message situation? */
- UNLINK_MESSAGE(c_p, msgp);
- free_message(msgp);
- goto loop_rec__;
+ SWAPOUT; /* erts_decode_dist_message() may write to heap... */
+ if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) {
+ /*
+ * A corrupt distribution message that we weren't able to decode;
+ * remove it...
+ */
+ /* No swapin should be needed */
+ ASSERT(HTOP == c_p->htop && E == c_p->stop);
+ /* TODO: Add DTrace probe for this bad message situation? */
+ UNLINK_MESSAGE(c_p, msgp);
+ msgp->next = NULL;
+ erts_cleanup_messages(msgp);
+ goto loop_rec__;
+ }
+ SWAPIN;
}
PreFetch(1, next);
r(0) = ERL_MESSAGE_TERM(msgp);
@@ -1981,8 +1907,7 @@ void process_main(void)
*/
OpCase(remove_message): {
BeamInstr *next;
- ErlMessage* msgp;
-
+ ErtsMessage* msgp;
PROCESS_MAIN_CHK_LOCKS(c_p);
PreFetch(0, next);
@@ -1996,20 +1921,7 @@ void process_main(void)
if (DT_UTAG(c_p) != NIL) {
if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) {
SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag;
-#ifdef DTRACE_TAG_HARDDEBUG
- if (DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING)
- erts_fprintf(stderr,
- "Dtrace -> (%T) stop spreading "
- "tag %T with message %T\r\n",
- c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp));
-#endif
} else {
-#ifdef DTRACE_TAG_HARDDEBUG
- erts_fprintf(stderr,
- "Dtrace -> (%T) kill tag %T with "
- "message %T\r\n",
- c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp));
-#endif
DT_UTAG(c_p) = NIL;
SEQ_TRACE_TOKEN(c_p) = NIL;
}
@@ -2029,12 +1941,6 @@ void process_main(void)
DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp);
}
DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING;
-#ifdef DTRACE_TAG_HARDDEBUG
- erts_fprintf(stderr,
- "Dtrace -> (%T) receive tag (%T) "
- "with message %T\r\n",
- c_p->common.id, DT_UTAG(c_p), ERL_MESSAGE_TERM(msgp));
-#endif
} else {
#endif
ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p)));
@@ -2064,7 +1970,7 @@ void process_main(void)
dtrace_proc_str(c_p, receiver_name);
token2 = SEQ_TRACE_TOKEN(c_p);
- if (token2 != NIL && token2 != am_have_dt_utag) {
+ if (have_seqtrace(token2)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token2));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2));
@@ -2077,11 +1983,21 @@ void process_main(void)
UNLINK_MESSAGE(c_p, msgp);
JOIN_MESSAGE(c_p);
CANCEL_TIMER(c_p);
- free_message(msgp);
+
+ erts_save_message_in_proc(c_p, msgp);
+ c_p->flags &= ~F_DELAY_GC;
+
+ if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) {
+ /*
+ * We want to GC soon but we leave a few
+ * reductions giving the message some time
+ * to turn into garbage.
+ */
+ ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS);
+ }
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
-
NextPF(0, next);
}
@@ -2090,9 +2006,22 @@ void process_main(void)
* message didn't match), then jump to the loop_rec instruction.
*/
OpCase(loop_rec_end_f): {
+
+ ASSERT(c_p->flags & F_DELAY_GC);
+
SET_I((BeamInstr *) Arg(0));
SAVE_MESSAGE(c_p);
- goto loop_rec__;
+ if (FCALLS > 0 || FCALLS > neg_o_reds) {
+ FCALLS--;
+ goto loop_rec__;
+ }
+
+ c_p->flags &= ~F_DELAY_GC;
+ c_p->i = I;
+ SWAPOUT;
+ c_p->arity = 0;
+ c_p->current = NULL;
+ goto do_schedule;
}
/*
* Prepare to wait for a message or a timeout, whichever occurs first.
@@ -2131,8 +2060,6 @@ void process_main(void)
* c_p->def_arg_reg[0]. Note that it is safe to use this
* location because there are no living x registers in
* a receive statement.
- * Note that for the halfword emulator, the two first elements
- * of the array are used.
*/
BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg;
*pi = I+3;
@@ -2249,10 +2176,6 @@ void process_main(void)
select_val2 = xb(Arg(0));
goto do_select_tuple_arity2;
- OpCase(i_select_tuple_arity2_rfAAff):
- select_val2 = r(0);
- I--;
-
do_select_tuple_arity2:
if (is_not_tuple(select_val2)) {
goto select_val2_fail;
@@ -2268,10 +2191,6 @@ void process_main(void)
select_val2 = xb(Arg(0));
goto do_select_val2;
- OpCase(i_select_val2_rfccff):
- select_val2 = r(0);
- I--;
-
do_select_val2:
if (select_val2 == Arg(2)) {
I += 3;
@@ -2295,10 +2214,6 @@ void process_main(void)
select_val = yb(Arg(0));
goto do_select_tuple_arity;
- OpCase(i_select_tuple_arity_rfI):
- select_val = r(0);
- I--;
-
do_select_tuple_arity:
if (is_tuple(select_val)) {
select_val = *tuple_val(select_val);
@@ -2315,10 +2230,6 @@ void process_main(void)
select_val = yb(Arg(0));
goto do_linear_search;
- OpCase(i_select_val_lins_rfI):
- select_val = r(0);
- I--;
-
do_linear_search: {
BeamInstr *vs = &Arg(3);
int ix = 0;
@@ -2345,10 +2256,6 @@ void process_main(void)
select_val = yb(Arg(0));
goto do_binary_search;
- OpCase(i_select_val_bins_rfI):
- select_val = r(0);
- I--;
-
do_binary_search:
{
struct Pairs {
@@ -2409,10 +2316,6 @@ void process_main(void)
jump_on_val_zero_index = xb(Arg(0));
goto do_jump_on_val_zero_index;
- OpCase(i_jump_on_val_zero_rfI):
- jump_on_val_zero_index = r(0);
- I--;
-
do_jump_on_val_zero_index:
if (is_small(jump_on_val_zero_index)) {
jump_on_val_zero_index = signed_val(jump_on_val_zero_index);
@@ -2437,10 +2340,6 @@ void process_main(void)
jump_on_val_index = xb(Arg(0));
goto do_jump_on_val_index;
- OpCase(i_jump_on_val_rfII):
- jump_on_val_index = r(0);
- I--;
-
do_jump_on_val_index:
if (is_small(jump_on_val_index)) {
jump_on_val_index = (Uint) (signed_val(jump_on_val_index) - Arg(3));
@@ -2460,15 +2359,12 @@ void process_main(void)
do {
Eterm term = *I++;
- switch (term & _TAG_IMMED1_MASK) {
- case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
- *hp++ = r(0);
- break;
- case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
- *hp++ = x(term >> _TAG_IMMED1_SIZE);
+ switch (loader_tag(term)) {
+ case LOADER_X_REG:
+ *hp++ = x(loader_x_reg_index(term));
break;
- case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
- *hp++ = y(term >> _TAG_IMMED1_SIZE);
+ case LOADER_Y_REG:
+ *hp++ = y(loader_y_reg_index(term));
break;
default:
*hp++ = term;
@@ -2482,31 +2378,26 @@ void process_main(void)
OpCase(new_map_dII): {
Eterm res;
- x(0) = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
res = new_map(c_p, reg, I-1);
- SWAPIN;
- r(0) = x(0);
+ HEAVY_SWAPIN;
StoreResult(res, Arg(0));
Next(3+Arg(2));
}
-#define PUT_TERM_REG(term, desc) \
-do { \
- switch ((desc) & _TAG_IMMED1_MASK) { \
- case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- r(0) = (term); \
- break; \
- case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- x((desc) >> _TAG_IMMED1_SIZE) = (term); \
- break; \
- case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- y((desc) >> _TAG_IMMED1_SIZE) = (term); \
- break; \
- default: \
- ASSERT(0); \
- break; \
- } \
+#define PUT_TERM_REG(term, desc) \
+do { \
+ switch (loader_tag(desc)) { \
+ case LOADER_X_REG: \
+ x(loader_x_reg_index(desc)) = (term); \
+ break; \
+ case LOADER_Y_REG: \
+ y(loader_y_reg_index(desc)) = (term); \
+ break; \
+ default: \
+ ASSERT(0); \
+ break; \
+ } \
} while(0)
OpCase(i_get_map_elements_fsI): {
@@ -2577,12 +2468,10 @@ do { \
Eterm map;
GetArg1(1, map);
- x(0) = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
res = update_map_assoc(c_p, reg, map, I);
- SWAPIN;
+ HEAVY_SWAPIN;
if (is_value(res)) {
- r(0) = x(0);
StoreResult(res, Arg(2));
Next(5+Arg(4));
} else {
@@ -2601,12 +2490,10 @@ do { \
Eterm map;
GetArg1(1, map);
- x(0) = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
res = update_map_exact(c_p, reg, map, I);
- SWAPIN;
+ HEAVY_SWAPIN;
if (is_value(res)) {
- r(0) = x(0);
StoreResult(res, Arg(2));
Next(5+Arg(4));
} else {
@@ -2688,13 +2575,10 @@ do { \
{
typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
GcBifFunction bf;
- Eterm arg;
Eterm result;
Uint live = (Uint) Arg(3);
- GetArg1(2, arg);
- reg[0] = r(0);
- reg[live] = arg;
+ GetArg1(2, x(live));
bf = (GcBifFunction) Arg(1);
c_p->fcalls = FCALLS;
SWAPOUT;
@@ -2705,7 +2589,6 @@ do { \
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
SWAPIN;
- r(0) = reg[0];
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
@@ -2715,12 +2598,12 @@ do { \
SET_I((BeamInstr *) Arg(0));
Goto(*I);
}
- reg[0] = arg;
+ x(0) = x(live);
I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
goto post_error_handling;
}
- OpCase(i_gc_bif2_jIId): /* Note, one less parameter than the i_gc_bif1
+ OpCase(i_gc_bif2_jIIssd): /* Note, one less parameter than the i_gc_bif1
and i_gc_bif3 */
{
typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
@@ -2728,9 +2611,13 @@ do { \
Eterm result;
Uint live = (Uint) Arg(2);
- reg[0] = r(0);
- reg[live++] = tmp_arg1;
- reg[live] = tmp_arg2;
+ GetArg2(3, x(live), x(live+1));
+ /*
+ * XXX This calling convention does not make sense. 'live'
+ * should point out the first argument, not the second
+ * (i.e. 'live' should not be incremented below).
+ */
+ live++;
bf = (GcBifFunction) Arg(1);
c_p->fcalls = FCALLS;
SWAPOUT;
@@ -2741,35 +2628,37 @@ do { \
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
SWAPIN;
- r(0) = reg[0];
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
- StoreBifResult(3, result);
+ StoreBifResult(5, result);
}
if (Arg(0) != 0) {
SET_I((BeamInstr *) Arg(0));
Goto(*I);
}
- reg[0] = tmp_arg1;
- reg[1] = tmp_arg2;
+ live--;
+ x(0) = x(live);
+ x(1) = x(live+1);
I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
goto post_error_handling;
}
- OpCase(i_gc_bif3_jIsId):
+ OpCase(i_gc_bif3_jIIssd):
{
typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
GcBifFunction bf;
- Eterm arg;
Eterm result;
- Uint live = (Uint) Arg(3);
+ Uint live = (Uint) Arg(2);
- GetArg1(2, arg);
- reg[0] = r(0);
- reg[live++] = arg;
- reg[live++] = tmp_arg1;
- reg[live] = tmp_arg2;
+ x(live) = x(SCRATCH_X_REG);
+ GetArg2(3, x(live+1), x(live+2));
+ /*
+ * XXX This calling convention does not make sense. 'live'
+ * should point out the first argument, not the third
+ * (i.e. 'live' should not be incremented below).
+ */
+ live += 2;
bf = (GcBifFunction) Arg(1);
c_p->fcalls = FCALLS;
SWAPOUT;
@@ -2780,19 +2669,19 @@ do { \
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
SWAPIN;
- r(0) = reg[0];
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
- StoreBifResult(4, result);
+ StoreBifResult(5, result);
}
if (Arg(0) != 0) {
SET_I((BeamInstr *) Arg(0));
Goto(*I);
}
- reg[0] = arg;
- reg[1] = tmp_arg1;
- reg[2] = tmp_arg2;
+ live -= 2;
+ x(0) = x(live);
+ x(1) = x(live+1);
+ x(2) = x(live+2);
I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
goto post_error_handling;
}
@@ -2800,12 +2689,13 @@ do { \
/*
* Guards bifs and, or, xor in guards.
*/
- OpCase(i_bif2_fbd):
+ OpCase(i_bif2_fbssd):
{
- Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2};
+ Eterm tmp_reg[2];
Eterm (*bf)(Process*, Eterm*);
Eterm result;
+ GetArg2(2, tmp_reg[0], tmp_reg[1]);
bf = (BifFunction) Arg(1);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2817,7 +2707,7 @@ do { \
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
- StoreBifResult(2, result);
+ StoreBifResult(4, result);
}
SET_I((BeamInstr *) Arg(0));
Goto(*I);
@@ -2826,12 +2716,13 @@ do { \
/*
* Guards bifs and, or, xor, relational operators in body.
*/
- OpCase(i_bif2_body_bd):
+ OpCase(i_bif2_body_bssd):
{
- Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2};
+ Eterm tmp_reg[2];
Eterm (*bf)(Process*, Eterm*);
Eterm result;
+ GetArg2(1, tmp_reg[0], tmp_reg[1]);
bf = (BifFunction) Arg(0);
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
@@ -2842,10 +2733,10 @@ do { \
ERTS_HOLE_CHECK(c_p);
if (is_value(result)) {
ASSERT(!is_CP(result));
- StoreBifResult(1, result);
+ StoreBifResult(3, result);
}
- reg[0] = tmp_arg1;
- reg[1] = tmp_arg2;
+ reg[0] = tmp_reg[0];
+ reg[1] = tmp_reg[1];
SWAPOUT;
I = handle_error(c_p, I, reg, bf);
goto post_error_handling;
@@ -2857,9 +2748,20 @@ do { \
*/
OpCase(call_bif_e):
{
- Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
+ Eterm (*bf)(Process*, Eterm*, BeamInstr*);
Eterm result;
BeamInstr *next;
+ ErlHeapFragment *live_hf_end;
+
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X()) {
+ if (GET_BIF_MODULE(Arg(0)) == am_ets) {
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS);
+ } else {
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF);
+ }
+ }
+
+ bf = GET_BIF_ADDRESS(Arg(0));
PRE_BIF_SWAPOUT(c_p);
c_p->fcalls = FCALLS - 1;
@@ -2869,20 +2771,26 @@ do { \
PreFetch(1, next);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- reg[0] = r(0);
+ live_hf_end = c_p->mbuf;
result = (*bf)(c_p, reg, I);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
ERTS_HOLE_CHECK(c_p);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) {
+ if (ERTS_IS_GC_DESIRED(c_p)) {
Uint arity = ((Export *)Arg(0))->code[2];
- result = erts_gc_after_bif_call(c_p, result, reg, arity);
+ result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, reg, arity);
E = c_p->stop;
}
+ PROCESS_MAIN_CHK_LOCKS(c_p);
HTOP = HEAP_TOP(c_p);
FCALLS = c_p->fcalls;
+ /* We have to update the cache if we are enabled in order
+ to make sure no book keeping is done after we disabled
+ msacc. We don't always do this as it is quite expensive. */
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X())
+ ERTS_MSACC_UPDATE_CACHE_X();
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
if (is_value(result)) {
r(0) = result;
CHECK_TERM(r(0));
@@ -2891,7 +2799,6 @@ do { \
SET_CP(c_p, I+2);
SET_I(c_p->i);
SWAPIN;
- r(0) = reg[0];
Dispatch();
}
@@ -2907,111 +2814,81 @@ do { \
* Arithmetic operations.
*/
- OpCase(i_times_jId):
+ OpCase(i_times_jIssd):
{
- arith_func = ARITH_FUNC(mixed_times);
- goto do_big_arith2;
+ Eterm Op1, Op2;
+ GetArg2(2, Op1, Op2);
+ DO_OUTLINED_ARITH_2(mixed_times, Op1, Op2);
}
- OpCase(i_m_div_jId):
+ OpCase(i_m_div_jIssd):
{
- arith_func = ARITH_FUNC(mixed_div);
- goto do_big_arith2;
+ Eterm Op1, Op2;
+ GetArg2(2, Op1, Op2);
+ DO_OUTLINED_ARITH_2(mixed_div, Op1, Op2);
}
- OpCase(i_int_div_jId):
+ OpCase(i_int_div_jIssd):
{
- Eterm result;
+ Eterm Op1, Op2;
- if (tmp_arg2 == SMALL_ZERO) {
+ GetArg2(2, Op1, Op2);
+ if (Op2 == SMALL_ZERO) {
goto badarith;
- } else if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint ires = signed_val(tmp_arg1) / signed_val(tmp_arg2);
+ } else if (is_both_small(Op1, Op2)) {
+ Sint ires = signed_val(Op1) / signed_val(Op2);
if (MY_IS_SSMALL(ires)) {
- result = make_small(ires);
- STORE_ARITH_RESULT(result);
+ Eterm result = make_small(ires);
+ StoreBifResult(4, result);
}
}
- arith_func = ARITH_FUNC(int_div);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(int_div, Op1, Op2);
}
- OpCase(i_rem_jIxxd):
{
- Eterm result;
+ Eterm RemOp1, RemOp2;
- if (xb(Arg(3)) == SMALL_ZERO) {
- goto badarith;
- } else if (is_both_small(xb(Arg(2)), xb(Arg(3)))) {
- result = make_small(signed_val(xb(Arg(2))) % signed_val(xb(Arg(3))));
+ OpCase(i_rem_jIxxd):
+ RemOp1 = xb(Arg(2));
+ RemOp2 = xb(Arg(3));
+ goto do_rem;
+
+ OpCase(i_rem_jIssd):
+ GetArg2(2, RemOp1, RemOp2);
+ goto do_rem;
+
+ do_rem:
+ if (RemOp2 == SMALL_ZERO) {
+ goto badarith;
+ } else if (is_both_small(RemOp1, RemOp2)) {
+ Eterm result = make_small(signed_val(RemOp1) % signed_val(RemOp2));
StoreBifResult(4, result);
+ } else {
+ DO_OUTLINED_ARITH_2(int_rem, RemOp1, RemOp2);
}
- DO_BIG_ARITH(ARITH_FUNC(int_rem),xb(Arg(2)),xb(Arg(3)));
}
- OpCase(i_rem_jId):
{
- Eterm result;
-
- if (tmp_arg2 == SMALL_ZERO) {
- goto badarith;
- } else if (is_both_small(tmp_arg1, tmp_arg2)) {
- result = make_small(signed_val(tmp_arg1) % signed_val(tmp_arg2));
- STORE_ARITH_RESULT(result);
- } else {
- arith_func = ARITH_FUNC(int_rem);
- goto do_big_arith2;
- }
- }
+ Eterm BandOp1, BandOp2;
OpCase(i_band_jIxcd):
- {
- Eterm result;
+ BandOp1 = xb(Arg(2));
+ BandOp2 = Arg(3);
+ goto do_band;
- if (is_both_small(xb(Arg(2)), Arg(3))) {
+ OpCase(i_band_jIssd):
+ GetArg2(2, BandOp1, BandOp2);
+ goto do_band;
+
+ do_band:
+ if (is_both_small(BandOp1, BandOp2)) {
/*
* No need to untag -- TAG & TAG == TAG.
*/
- result = xb(Arg(2)) & Arg(3);
+ Eterm result = BandOp1 & BandOp2;
StoreBifResult(4, result);
}
- DO_BIG_ARITH(ARITH_FUNC(band),xb(Arg(2)),Arg(3));
- }
-
- OpCase(i_band_jId):
- {
- Eterm result;
-
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- /*
- * No need to untag -- TAG & TAG == TAG.
- */
- result = tmp_arg1 & tmp_arg2;
- STORE_ARITH_RESULT(result);
- }
- arith_func = ARITH_FUNC(band);
- goto do_big_arith2;
- }
-
-#undef DO_BIG_ARITH
-
- do_big_arith2:
- {
- Eterm result;
- Uint live = Arg(1);
-
- SWAPOUT;
- reg[0] = r(0);
- reg[live] = tmp_arg1;
- reg[live+1] = tmp_arg2;
- result = arith_func(c_p, reg, live);
- r(0) = reg[0];
- SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- if (is_value(result)) {
- STORE_ARITH_RESULT(result);
- }
- goto lb_Cl_error;
+ DO_OUTLINED_ARITH_2(band, BandOp1, BandOp2);
}
/*
@@ -3032,97 +2909,105 @@ do { \
goto find_func_info;
}
- OpCase(i_bor_jId):
+ OpCase(i_bor_jIssd):
{
- Eterm result;
+ Eterm Op1, Op2;
- if (is_both_small(tmp_arg1, tmp_arg2)) {
+ GetArg2(2, Op1, Op2);
+ if (is_both_small(Op1, Op2)) {
/*
* No need to untag -- TAG | TAG == TAG.
*/
- result = tmp_arg1 | tmp_arg2;
- STORE_ARITH_RESULT(result);
+ Eterm result = Op1 | Op2;
+ StoreBifResult(4, result);
}
- arith_func = ARITH_FUNC(bor);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(bor, Op1, Op2);
}
- OpCase(i_bxor_jId):
+ OpCase(i_bxor_jIssd):
{
- Eterm result;
+ Eterm Op1, Op2;
- if (is_both_small(tmp_arg1, tmp_arg2)) {
+ GetArg2(2, Op1, Op2);
+ if (is_both_small(Op1, Op2)) {
/*
* We could extract the tag from one argument, but a tag extraction
* could mean a shift. Therefore, play it safe here.
*/
- result = make_small(signed_val(tmp_arg1) ^ signed_val(tmp_arg2));
- STORE_ARITH_RESULT(result);
+ Eterm result = make_small(signed_val(Op1) ^ signed_val(Op2));
+ StoreBifResult(4, result);
}
- arith_func = ARITH_FUNC(bxor);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(bxor, Op1, Op2);
}
{
+ Eterm Op1, Op2;
Sint i;
Sint ires;
Eterm* bigp;
+ Eterm tmp_big[2];
- OpCase(i_bsr_jId):
- if (is_small(tmp_arg2)) {
- i = -signed_val(tmp_arg2);
- if (is_small(tmp_arg1)) {
+ OpCase(i_bsr_jIssd):
+ GetArg2(2, Op1, Op2);
+ if (is_small(Op2)) {
+ i = -signed_val(Op2);
+ if (is_small(Op1)) {
goto small_shift;
- } else if (is_big(tmp_arg1)) {
+ } else if (is_big(Op1)) {
if (i == 0) {
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
}
goto big_shift;
}
- } else if (is_big(tmp_arg2)) {
+ } else if (is_big(Op2)) {
/*
* N bsr NegativeBigNum == N bsl MAX_SMALL
* N bsr PositiveBigNum == N bsl MIN_SMALL
*/
- tmp_arg2 = make_small(bignum_header_is_neg(*big_val(tmp_arg2)) ?
+ Op2 = make_small(bignum_header_is_neg(*big_val(Op2)) ?
MAX_SMALL : MIN_SMALL);
goto do_bsl;
}
goto badarith;
- OpCase(i_bsl_jId):
+ OpCase(i_bsl_jIssd):
+ GetArg2(2, Op1, Op2);
+
do_bsl:
- if (is_small(tmp_arg2)) {
- i = signed_val(tmp_arg2);
+ if (is_small(Op2)) {
+ i = signed_val(Op2);
- if (is_small(tmp_arg1)) {
+ if (is_small(Op1)) {
small_shift:
- ires = signed_val(tmp_arg1);
+ ires = signed_val(Op1);
if (i == 0 || ires == 0) {
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
} else if (i < 0) { /* Right shift */
i = -i;
if (i >= SMALL_BITS-1) {
- tmp_arg1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
+ Op1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
} else {
- tmp_arg1 = make_small(ires >> i);
+ Op1 = make_small(ires >> i);
}
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
} else if (i < SMALL_BITS-1) { /* Left shift */
if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) ||
((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) {
- tmp_arg1 = make_small(ires << i);
- StoreBifResult(2, tmp_arg1);
+ Op1 = make_small(ires << i);
+ StoreBifResult(4, Op1);
}
}
- tmp_arg1 = small_to_big(ires, tmp_big);
+ Op1 = small_to_big(ires, tmp_big);
+#ifdef TAG_LITERAL_PTR
+ Op1 |= TAG_LITERAL_PTR;
+#endif
big_shift:
if (i > 0) { /* Left shift. */
- ires = big_size(tmp_arg1) + (i / D_EXP);
+ ires = big_size(Op1) + (i / D_EXP);
} else { /* Right shift. */
- ires = big_size(tmp_arg1);
+ ires = big_size(Op1);
if (ires <= (-i / D_EXP))
ires = 3; /* ??? */
else
@@ -3140,14 +3025,14 @@ do { \
c_p->freason = SYSTEM_LIMIT;
goto lb_Cl_error;
}
- TestHeapPreserve(ires+1, Arg(1), tmp_arg1);
+ TestHeapPreserve(ires+1, Arg(1), Op1);
bigp = HTOP;
- tmp_arg1 = big_lshift(tmp_arg1, i, bigp);
- if (is_big(tmp_arg1)) {
+ Op1 = big_lshift(Op1, i, bigp);
+ if (is_big(Op1)) {
HTOP += bignum_header_arity(*HTOP) + 1;
}
HEAP_SPACE_VERIFIED(0);
- if (is_nil(tmp_arg1)) {
+ if (is_nil(Op1)) {
/*
* This result must have been only slight larger
* than allowed since it wasn't caught by the
@@ -3157,25 +3042,25 @@ do { \
goto lb_Cl_error;
}
ERTS_HOLE_CHECK(c_p);
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
}
- } else if (is_big(tmp_arg1)) {
+ } else if (is_big(Op1)) {
if (i == 0) {
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
}
goto big_shift;
}
- } else if (is_big(tmp_arg2)) {
- if (bignum_header_is_neg(*big_val(tmp_arg2))) {
+ } else if (is_big(Op2)) {
+ if (bignum_header_is_neg(*big_val(Op2))) {
/*
* N bsl NegativeBigNum is either 0 or -1, depending on
* the sign of N. Since we don't believe this case
* is common, do the calculation with the minimum
* amount of code.
*/
- tmp_arg2 = make_small(MIN_SMALL);
+ Op2 = make_small(MIN_SMALL);
goto do_bsl;
- } else if (is_small(tmp_arg1) || is_big(tmp_arg1)) {
+ } else if (is_small(Op1) || is_big(Op1)) {
/*
* N bsl PositiveBigNum is too large to represent.
*/
@@ -3199,12 +3084,10 @@ do { \
bnot_val = make_small(~signed_val(bnot_val));
} else {
Uint live = Arg(2);
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
reg[live] = bnot_val;
bnot_val = erts_gc_bnot(c_p, reg, live);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPIN;
ERTS_HOLE_CHECK(c_p);
if (is_nil(bnot_val)) {
goto lb_Cl_error;
@@ -3219,11 +3102,10 @@ do { \
OpCase(i_apply): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply(c_p, r(0), x(1), x(2), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+1);
SET_I(next);
Dispatch();
@@ -3234,12 +3116,11 @@ do { \
OpCase(i_apply_last_P): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply(c_p, r(0), x(1), x(2), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
- SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0]));
+ SET_CP(c_p, (BeamInstr *) E[0]);
E = ADD_BYTE_OFFSET(E, Arg(0));
SET_I(next);
Dispatch();
@@ -3250,11 +3131,10 @@ do { \
OpCase(i_apply_only): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply(c_p, r(0), x(1), x(2), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_I(next);
Dispatch();
}
@@ -3265,12 +3145,10 @@ do { \
OpCase(apply_I): {
BeamInstr *next;
- reg[0] = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = fixed_apply(c_p, reg, Arg(0));
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+2);
SET_I(next);
Dispatch();
@@ -3282,13 +3160,11 @@ do { \
OpCase(apply_last_IP): {
BeamInstr *next;
- reg[0] = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = fixed_apply(c_p, reg, Arg(0));
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
- SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0]));
+ SET_CP(c_p, (BeamInstr *) E[0]);
E = ADD_BYTE_OFFSET(E, Arg(1));
SET_I(next);
Dispatch();
@@ -3300,11 +3176,10 @@ do { \
OpCase(i_apply_fun): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply_fun(c_p, r(0), x(1), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+1);
SET_I(next);
Dispatchfun();
@@ -3315,12 +3190,11 @@ do { \
OpCase(i_apply_fun_last_P): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply_fun(c_p, r(0), x(1), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
- SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0]));
+ SET_CP(c_p, (BeamInstr *) E[0]);
E = ADD_BYTE_OFFSET(E, Arg(0));
SET_I(next);
Dispatchfun();
@@ -3331,11 +3205,10 @@ do { \
OpCase(i_apply_fun_only): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply_fun(c_p, r(0), x(1), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_I(next);
Dispatchfun();
}
@@ -3345,13 +3218,10 @@ do { \
OpCase(i_call_fun_I): {
BeamInstr *next;
- SWAPOUT;
- reg[0] = r(0);
-
+ HEAVY_SWAPOUT;
next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+2);
SET_I(next);
Dispatchfun();
@@ -3362,13 +3232,11 @@ do { \
OpCase(i_call_fun_last_IP): {
BeamInstr *next;
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
- SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0]));
+ SET_CP(c_p, (BeamInstr *) E[0]);
E = ADD_BYTE_OFFSET(E, Arg(1));
SET_I(next);
Dispatchfun();
@@ -3452,10 +3320,9 @@ do { \
*/
argp = c_p->arg_reg;
- for (i = c_p->arity - 1; i > 0; i--) {
+ for (i = c_p->arity - 1; i >= 0; i--) {
argp[i] = reg[i];
}
- c_p->arg_reg[0] = r(0);
SWAPOUT;
c_p->i = I;
goto do_schedule1;
@@ -3468,19 +3335,14 @@ do { \
Eterm* p;
PreFetch(3, next);
- GetArg2(0, element, tuple);
+ GetArg1(0, element);
+ tuple = REG_TARGET(Arg(1));
ASSERT(is_tuple(tuple));
p = (Eterm *) ((unsigned char *) tuple_val(tuple) + Arg(2));
*p = element;
NextPF(3, next);
}
- OpCase(i_is_ne_exact_f):
- if (EQ(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
OpCase(normal_exit): {
SWAPOUT;
c_p->freason = EXC_NORMAL;
@@ -3547,25 +3409,14 @@ do { \
{
Eterm badmatch_val;
- OpCase(badmatch_y):
- badmatch_val = yb(Arg(0));
- goto do_badmatch;
-
OpCase(badmatch_x):
badmatch_val = xb(Arg(0));
- goto do_badmatch;
-
- OpCase(badmatch_r):
- badmatch_val = r(0);
-
- do_badmatch:
c_p->fvalue = badmatch_val;
c_p->freason = BADMATCH;
}
/* Fall through here */
find_func_info: {
- reg[0] = r(0);
SWAPOUT;
I = handle_error(c_p, I, reg, NULL);
goto post_error_handling;
@@ -3582,11 +3433,9 @@ do { \
* code[3]: &&call_error_handler
* code[4]: Not used
*/
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
I = call_error_handler(c_p, I-3, reg, am_undefined_function);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPIN;
if (I) {
Goto(*I);
}
@@ -3594,18 +3443,13 @@ do { \
/* Fall through */
OpCase(error_action_code): {
handle_error:
- reg[0] = r(0);
SWAPOUT;
I = handle_error(c_p, NULL, reg, NULL);
post_error_handling:
if (I == 0) {
goto do_schedule;
} else {
- r(0) = reg[0];
ASSERT(!is_value(r(0)));
- if (c_p->mbuf) {
- erts_garbage_collect(c_p, 0, reg+1, 3);
- }
SWAPIN;
Goto(*I);
}
@@ -3629,6 +3473,9 @@ do { \
* I[3]: Function pointer to dirty NIF
*/
BifFunction vbf;
+ ErlHeapFragment *live_hf_end;
+
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF);
DTRACE_NIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
c_p->current = I-3; /* current and vbf set to please handle_error */
@@ -3644,7 +3491,7 @@ do { \
NifF* fp = vbf = (NifF*) I[1];
struct enif_environment_t env;
erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]);
- reg[0] = r(0);
+ live_hf_end = c_p->mbuf;
nif_bif_result = (*fp)(&env, bif_nif_arity, reg);
if (env.exception_thrown)
nif_bif_result = THE_NON_VALUE;
@@ -3654,6 +3501,8 @@ do { \
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
+
DTRACE_NIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
goto apply_bif_or_nif_epilogue;
@@ -3668,6 +3517,13 @@ do { \
* code[3]: &&apply_bif
* code[4]: Function pointer to BIF function
*/
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X()) {
+ if ((Eterm)I[-3] == am_ets) {
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS);
+ } else {
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF);
+ }
+ }
c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */
c_p->i = I; /* In case we apply check_process_code/2. */
@@ -3683,25 +3539,32 @@ do { \
bif_nif_arity = I[-1];
ASSERT(bif_nif_arity <= 4);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- reg[0] = r(0);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
{
Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf;
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ live_hf_end = c_p->mbuf;
nif_bif_result = (*bf)(c_p, reg, I);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
is_non_value(nif_bif_result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
}
-
+ /* We have to update the cache if we are enabled in order
+ to make sure no book keeping is done after we disabled
+ msacc. We don't always do this as it is quite expensive. */
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X())
+ ERTS_MSACC_UPDATE_CACHE_X();
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
DTRACE_BIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
apply_bif_or_nif_epilogue:
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
ERTS_HOLE_CHECK(c_p);
- if (c_p->mbuf) {
- nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result,
- reg, bif_nif_arity);
+ if (ERTS_IS_GC_DESIRED(c_p)) {
+ nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end,
+ nif_bif_result,
+ reg, bif_nif_arity);
}
SWAPIN; /* There might have been a garbage collection. */
FCALLS = c_p->fcalls;
@@ -3713,7 +3576,6 @@ do { \
Goto(*I);
} else if (c_p->freason == TRAP) {
SET_I(c_p->i);
- r(0) = reg[0];
if (c_p->flags & F_HIBERNATE_SCHED) {
c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
@@ -3735,21 +3597,21 @@ do { \
StoreBifResult(1, result);
}
+ OpCase(i_get_hash_cId):
+ {
+ Eterm arg;
+ Eterm result;
+
+ GetArg1(0, arg);
+ result = erts_pd_hash_get_with_hx(c_p, Arg(1), arg);
+ StoreBifResult(2, result);
+ }
+
{
Eterm case_end_val;
OpCase(case_end_x):
case_end_val = xb(Arg(0));
- goto do_case_end;
-
- OpCase(case_end_y):
- case_end_val = yb(Arg(0));
- goto do_case_end;
-
- OpCase(case_end_r):
- case_end_val = r(0);
-
- do_case_end:
c_p->fvalue = case_end_val;
c_p->freason = EXC_CASE_CLAUSE;
goto find_func_info;
@@ -3797,19 +3659,13 @@ do { \
goto do_bs_init_bits_known;
}
- OpCase(i_bs_init_bits_fail_heap_IjId): {
- /* tmp_arg1 was fetched by an i_fetch instruction */
- num_bits_term = tmp_arg1;
- alloc = Arg(0);
- I++;
+ OpCase(i_bs_init_bits_fail_heap_sIjId): {
+ GetArg1(0, num_bits_term);
+ alloc = Arg(1);
+ I += 2;
goto do_bs_init_bits;
}
- OpCase(i_bs_init_bits_fail_rjId): {
- num_bits_term = r(0);
- alloc = 0;
- goto do_bs_init_bits;
- }
OpCase(i_bs_init_bits_fail_yjId): {
num_bits_term = yb(Arg(0));
I++;
@@ -3929,52 +3785,48 @@ do { \
}
{
- OpCase(i_bs_init_fail_heap_IjId): {
- /* tmp_arg1 was fetched by an i_fetch instruction */
- tmp_arg2 = Arg(0);
- I++;
- goto do_bs_init;
- }
+ Eterm BsOp1, BsOp2;
- OpCase(i_bs_init_fail_rjId): {
- tmp_arg1 = r(0);
- tmp_arg2 = 0;
+ OpCase(i_bs_init_fail_heap_sIjId): {
+ GetArg1(0, BsOp1);
+ BsOp2 = Arg(1);
+ I += 2;
goto do_bs_init;
}
OpCase(i_bs_init_fail_yjId): {
- tmp_arg1 = yb(Arg(0));
- tmp_arg2 = 0;
+ BsOp1 = yb(Arg(0));
+ BsOp2 = 0;
I++;
goto do_bs_init;
}
OpCase(i_bs_init_fail_xjId): {
- tmp_arg1 = xb(Arg(0));
- tmp_arg2 = 0;
+ BsOp1 = xb(Arg(0));
+ BsOp2 = 0;
I++;
}
/* FALL THROUGH */
do_bs_init:
- if (is_small(tmp_arg1)) {
- Sint size = signed_val(tmp_arg1);
+ if (is_small(BsOp1)) {
+ Sint size = signed_val(BsOp1);
if (size < 0) {
goto badarg;
}
- tmp_arg1 = (Eterm) size;
+ BsOp1 = (Eterm) size;
} else {
Uint bytes;
- if (!term_to_Uint(tmp_arg1, &bytes)) {
+ if (!term_to_Uint(BsOp1, &bytes)) {
c_p->freason = bytes;
goto lb_Cl_error;
}
if ((bytes >> (8*sizeof(Uint)-3)) != 0) {
goto system_limit;
}
- tmp_arg1 = (Eterm) bytes;
+ BsOp1 = (Eterm) bytes;
}
- if (tmp_arg1 <= ERL_ONHEAP_BIN_LIMIT) {
+ if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) {
goto do_heap_bin_alloc;
} else {
goto do_proc_bin_alloc;
@@ -3982,15 +3834,15 @@ do { \
OpCase(i_bs_init_heap_IIId): {
- tmp_arg1 = Arg(0);
- tmp_arg2 = Arg(1);
+ BsOp1 = Arg(0);
+ BsOp2 = Arg(1);
I++;
goto do_proc_bin_alloc;
}
OpCase(i_bs_init_IId): {
- tmp_arg1 = Arg(0);
- tmp_arg2 = 0;
+ BsOp1 = Arg(0);
+ BsOp2 = 0;
}
/* FALL THROUGH */
do_proc_bin_alloc: {
@@ -3999,13 +3851,13 @@ do { \
erts_bin_offset = 0;
erts_writable_bin = 0;
- TestBinVHeap(tmp_arg1 / sizeof(Eterm),
- tmp_arg2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1));
+ TestBinVHeap(BsOp1 / sizeof(Eterm),
+ BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1));
/*
* Allocate the binary struct itself.
*/
- bptr = erts_bin_nrml_alloc(tmp_arg1);
+ bptr = erts_bin_nrml_alloc(BsOp1);
erts_refc_init(&bptr->refc, 1);
erts_current_bin = (byte *) bptr->orig_bytes;
@@ -4015,28 +3867,28 @@ do { \
pb = (ProcBin *) HTOP;
HTOP += PROC_BIN_SIZE;
pb->thing_word = HEADER_PROC_BIN;
- pb->size = tmp_arg1;
+ pb->size = BsOp1;
pb->next = MSO(c_p).first;
MSO(c_p).first = (struct erl_off_heap_header*) pb;
pb->val = bptr;
pb->bytes = (byte*) bptr->orig_bytes;
pb->flags = 0;
- OH_OVERHEAD(&(MSO(c_p)), tmp_arg1 / sizeof(Eterm));
+ OH_OVERHEAD(&(MSO(c_p)), BsOp1 / sizeof(Eterm));
StoreBifResult(2, make_binary(pb));
}
OpCase(i_bs_init_heap_bin_heap_IIId): {
- tmp_arg1 = Arg(0);
- tmp_arg2 = Arg(1);
+ BsOp1 = Arg(0);
+ BsOp2 = Arg(1);
I++;
goto do_heap_bin_alloc;
}
OpCase(i_bs_init_heap_bin_IId): {
- tmp_arg1 = Arg(0);
- tmp_arg2 = 0;
+ BsOp1 = Arg(0);
+ BsOp2 = 0;
}
/* Fall through */
do_heap_bin_alloc:
@@ -4044,33 +3896,36 @@ do { \
ErlHeapBin* hb;
Uint bin_need;
- bin_need = heap_bin_size(tmp_arg1);
+ bin_need = heap_bin_size(BsOp1);
erts_bin_offset = 0;
erts_writable_bin = 0;
- TestHeap(bin_need+tmp_arg2+ERL_SUB_BIN_SIZE, Arg(1));
+ TestHeap(bin_need+BsOp2+ERL_SUB_BIN_SIZE, Arg(1));
hb = (ErlHeapBin *) HTOP;
HTOP += bin_need;
- hb->thing_word = header_heap_bin(tmp_arg1);
- hb->size = tmp_arg1;
+ hb->thing_word = header_heap_bin(BsOp1);
+ hb->size = BsOp1;
erts_current_bin = (byte *) hb->data;
- tmp_arg1 = make_binary(hb);
- StoreBifResult(2, tmp_arg1);
+ BsOp1 = make_binary(hb);
+ StoreBifResult(2, BsOp1);
}
}
- OpCase(i_bs_add_jId): {
- Uint Unit = Arg(1);
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint Arg1 = signed_val(tmp_arg1);
- Sint Arg2 = signed_val(tmp_arg2);
+ OpCase(bs_add_jssId): {
+ Eterm Op1, Op2;
+ Uint Unit = Arg(3);
+
+ GetArg2(1, Op1, Op2);
+ if (is_both_small(Op1, Op2)) {
+ Sint Arg1 = signed_val(Op1);
+ Sint Arg2 = signed_val(Op2);
if (Arg1 >= 0 && Arg2 >= 0) {
- BsSafeMul(Arg2, Unit, goto system_limit, tmp_arg1);
- tmp_arg1 += Arg1;
+ BsSafeMul(Arg2, Unit, goto system_limit, Op1);
+ Op1 += Arg1;
store_bs_add_result:
- if (tmp_arg1 <= MAX_SMALL) {
- tmp_arg1 = make_small(tmp_arg1);
+ if (Op1 <= MAX_SMALL) {
+ Op1 = make_small(Op1);
} else {
/*
* May generate a heap fragment, but in this
@@ -4082,10 +3937,10 @@ do { \
* references (such as the heap).
*/
SWAPOUT;
- tmp_arg1 = erts_make_integer(tmp_arg1, c_p);
+ Op1 = erts_make_integer(Op1, c_p);
HTOP = HEAP_TOP(c_p);
}
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
}
goto badarg;
} else {
@@ -4108,16 +3963,16 @@ do { \
* an Uint, the reason is SYSTEM_LIMIT.
*/
- if (!term_to_Uint(tmp_arg1, &a)) {
+ if (!term_to_Uint(Op1, &a)) {
if (a == BADARG) {
goto badarg;
}
- if (!term_to_Uint(tmp_arg2, &b)) {
+ if (!term_to_Uint(Op2, &b)) {
c_p->freason = b;
goto lb_Cl_error;
}
goto system_limit;
- } else if (!term_to_Uint(tmp_arg2, &b)) {
+ } else if (!term_to_Uint(Op2, &b)) {
c_p->freason = b;
goto lb_Cl_error;
}
@@ -4127,8 +3982,8 @@ do { \
*/
BsSafeMul(b, Unit, goto system_limit, c);
- tmp_arg1 = a + c;
- if (tmp_arg1 < a) {
+ Op1 = a + c;
+ if (Op1 < a) {
/*
* If the result is less than one of the
* arguments, there must have been an overflow.
@@ -4150,52 +4005,47 @@ do { \
}
/*
- * tmp_arg1 = Number of bytes to build
- * tmp_arg2 = Source binary
- * Operands: Fail ExtraHeap Live Unit Dst
+ * x(SCRATCH_X_REG);
+ * Operands: Fail ExtraHeap Live Unit Size Dst
*/
- OpCase(i_bs_append_jIIId): {
+ OpCase(i_bs_append_jIIIsd): {
Uint live = Arg(2);
Uint res;
+ Eterm Size;
- SWAPOUT;
- reg[0] = r(0);
- reg[live] = tmp_arg2;
- res = erts_bs_append(c_p, reg, live, tmp_arg1, Arg(1), Arg(3));
- r(0) = reg[0];
- SWAPIN;
+ GetArg1(4, Size);
+ HEAVY_SWAPOUT;
+ reg[live] = x(SCRATCH_X_REG);
+ res = erts_bs_append(c_p, reg, live, Size, Arg(1), Arg(3));
+ HEAVY_SWAPIN;
if (is_non_value(res)) {
/* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */
goto lb_Cl_error;
}
- StoreBifResult(4, res);
+ StoreBifResult(5, res);
}
/*
- * tmp_arg1 = Number of bytes to build
- * tmp_arg2 = Source binary
- * Operands: Fail Unit Dst
+ * Operands: Fail Size Src Unit Dst
*/
- OpCase(i_bs_private_append_jId): {
+ OpCase(i_bs_private_append_jIssd): {
Eterm res;
+ Eterm Size, Src;
- res = erts_bs_private_append(c_p, tmp_arg2, tmp_arg1, Arg(1));
+ GetArg2(2, Size, Src);
+ res = erts_bs_private_append(c_p, Src, Size, Arg(1));
if (is_non_value(res)) {
/* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */
goto lb_Cl_error;
}
- StoreBifResult(2, res);
+ StoreBifResult(4, res);
}
- /*
- * tmp_arg1 = Initial size of writable binary
- * Operands: Live Dst
- */
OpCase(bs_init_writable): {
- SWAPOUT;
+ HEAVY_SWAPOUT;
r(0) = erts_bs_init_writable(c_p, r(0));
- SWAPIN;
+ HEAVY_SWAPIN;
Next(0);
}
@@ -4286,26 +4136,29 @@ do { \
/*
* Only used for validating a value matched out.
- *
- * tmp_arg1 = Integer to validate
- * tmp_arg2 = Match context
*/
- OpCase(i_bs_validate_unicode_retract_j): {
- /*
- * There is no need to untag the integer, but it IS necessary
- * to make sure it is small (a bignum pointer could fall in
- * the valid range).
- */
- if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) ||
- (make_small(0xD800UL) <= tmp_arg1 &&
- tmp_arg1 <= make_small(0xDFFFUL))) {
- ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2);
+ OpCase(i_bs_validate_unicode_retract_jss): {
+ Eterm i; /* Integer to validate */
- mb->offset -= 32;
- goto badarg;
- }
- Next(1);
- }
+ /*
+ * There is no need to untag the integer, but it IS necessary
+ * to make sure it is small (a bignum pointer could fall in
+ * the valid range).
+ */
+
+ GetArg1(1, i);
+ if (is_not_small(i) || i > make_small(0x10FFFFUL) ||
+ (make_small(0xD800UL) <= i && i <= make_small(0xDFFFUL))) {
+ Eterm ms; /* Match context */
+ ErlBinMatchBuffer* mb;
+
+ GetArg1(2, ms);
+ mb = ms_matchbuffer(ms);
+ mb->offset -= 32;
+ goto badarg;
+ }
+ Next(3);
+ }
/*
* Matching of binaries.
@@ -4317,9 +4170,6 @@ do { \
Uint slots;
Eterm context;
- OpCase(i_bs_start_match2_rfIId): {
- context = r(0);
-
do_start_match:
slots = Arg(2);
if (!is_boxed(context)) {
@@ -4366,7 +4216,7 @@ do { \
ClauseFail();
}
NextPF(4, next);
- }
+
OpCase(i_bs_start_match2_xfIId): {
context = xb(Arg(0));
I++;
@@ -4379,18 +4229,6 @@ do { \
}
}
- OpCase(bs_test_zero_tail2_fr): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
-
- PreFetch(1, next);
- _mb = (ErlBinMatchBuffer*) ms_matchbuffer(r(0));
- if (_mb->size != _mb->offset) {
- ClauseFail();
- }
- NextPF(1, next);
- }
-
OpCase(bs_test_zero_tail2_fx): {
BeamInstr *next;
ErlBinMatchBuffer *_mb;
@@ -4403,16 +4241,6 @@ do { \
NextPF(2, next);
}
- OpCase(bs_test_tail_imm2_frI): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
- PreFetch(2, next);
- _mb = ms_matchbuffer(r(0));
- if (_mb->size - _mb->offset != Arg(1)) {
- ClauseFail();
- }
- NextPF(2, next);
- }
OpCase(bs_test_tail_imm2_fxI): {
BeamInstr *next;
ErlBinMatchBuffer *_mb;
@@ -4424,16 +4252,6 @@ do { \
NextPF(3, next);
}
- OpCase(bs_test_unit_frI): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
- PreFetch(2, next);
- _mb = ms_matchbuffer(r(0));
- if ((_mb->size - _mb->offset) % Arg(1)) {
- ClauseFail();
- }
- NextPF(2, next);
- }
OpCase(bs_test_unit_fxI): {
BeamInstr *next;
ErlBinMatchBuffer *_mb;
@@ -4445,16 +4263,6 @@ do { \
NextPF(3, next);
}
- OpCase(bs_test_unit8_fr): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
- PreFetch(1, next);
- _mb = ms_matchbuffer(r(0));
- if ((_mb->size - _mb->offset) & 7) {
- ClauseFail();
- }
- NextPF(1, next);
- }
OpCase(bs_test_unit8_fx): {
BeamInstr *next;
ErlBinMatchBuffer *_mb;
@@ -4469,19 +4277,11 @@ do { \
{
Eterm bs_get_integer8_context;
- OpCase(i_bs_get_integer_8_rfd): {
- bs_get_integer8_context = r(0);
- goto do_bs_get_integer_8;
- }
-
OpCase(i_bs_get_integer_8_xfd): {
- bs_get_integer8_context = xb(Arg(0));
- I++;
- }
-
- do_bs_get_integer_8: {
ErlBinMatchBuffer *_mb;
Eterm _result;
+ bs_get_integer8_context = xb(Arg(0));
+ I++;
_mb = ms_matchbuffer(bs_get_integer8_context);
if (_mb->size - _mb->offset < 8) {
ClauseFail();
@@ -4499,15 +4299,10 @@ do { \
{
Eterm bs_get_integer_16_context;
- OpCase(i_bs_get_integer_16_rfd):
- bs_get_integer_16_context = r(0);
- goto do_bs_get_integer_16;
-
OpCase(i_bs_get_integer_16_xfd):
bs_get_integer_16_context = xb(Arg(0));
I++;
- do_bs_get_integer_16:
{
ErlBinMatchBuffer *_mb;
Eterm _result;
@@ -4528,17 +4323,10 @@ do { \
{
Eterm bs_get_integer_32_context;
- OpCase(i_bs_get_integer_32_rfId):
- bs_get_integer_32_context = r(0);
- goto do_bs_get_integer_32;
-
-
OpCase(i_bs_get_integer_32_xfId):
bs_get_integer_32_context = xb(Arg(0));
I++;
-
- do_bs_get_integer_32:
{
ErlBinMatchBuffer *_mb;
Uint32 _integer;
@@ -4551,11 +4339,11 @@ do { \
_integer = get_int32(_mb->base + _mb->offset/8);
}
_mb->offset += 32;
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
if (IS_USMALL(0, _integer)) {
#endif
_result = make_small(_integer);
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
} else {
TestHeap(BIG_UINT_HEAP_SIZE, Arg(1));
_result = uint_to_big((Uint) _integer, HTOP);
@@ -4567,103 +4355,82 @@ do { \
}
}
- /* Operands: Size Live Fail Flags Dst */
- OpCase(i_bs_get_integer_imm_rIIfId): {
- tmp_arg1 = r(0);
- /* Operands: Size Live Fail Flags Dst */
- goto do_bs_get_integer_imm_test_heap;
- }
+ {
+ Eterm Ms, Sz;
- /* Operands: x(Reg) Size Live Fail Flags Dst */
+ /* Operands: x(Reg) Size Live Fail Flags Dst */
OpCase(i_bs_get_integer_imm_xIIfId): {
- tmp_arg1 = xb(Arg(0));
- I++;
- /* Operands: Size Live Fail Flags Dst */
- goto do_bs_get_integer_imm_test_heap;
- }
-
- /*
- * tmp_arg1 = match context
- * Operands: Size Live Fail Flags Dst
- */
- do_bs_get_integer_imm_test_heap: {
- Uint wordsneeded;
- tmp_arg2 = Arg(0);
- wordsneeded = 1+WSIZE(NBYTES(tmp_arg2));
- TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1);
- I += 2;
- /* Operands: Fail Flags Dst */
- goto do_bs_get_integer_imm;
- }
-
- /* Operands: Size Fail Flags Dst */
- OpCase(i_bs_get_integer_small_imm_rIfId): {
- tmp_arg1 = r(0);
- tmp_arg2 = Arg(0);
- I++;
- /* Operands: Fail Flags Dst */
- goto do_bs_get_integer_imm;
- }
+ Uint wordsneeded;
+ Ms = xb(Arg(0));
+ Sz = Arg(1);
+ wordsneeded = 1+WSIZE(NBYTES(Sz));
+ TestHeapPreserve(wordsneeded, Arg(2), Ms);
+ I += 3;
+ /* Operands: Fail Flags Dst */
+ goto do_bs_get_integer_imm;
+ }
- /* Operands: x(Reg) Size Fail Flags Dst */
+ /* Operands: x(Reg) Size Fail Flags Dst */
OpCase(i_bs_get_integer_small_imm_xIfId): {
- tmp_arg1 = xb(Arg(0));
- tmp_arg2 = Arg(1);
- I += 2;
- /* Operands: Fail Flags Dst */
- goto do_bs_get_integer_imm;
- }
+ Ms = xb(Arg(0));
+ Sz = Arg(1);
+ I += 2;
+ /* Operands: Fail Flags Dst */
+ goto do_bs_get_integer_imm;
+ }
- /*
- * tmp_arg1 = match context
- * tmp_arg2 = size of field
- * Operands: Fail Flags Dst
- */
+ /*
+ * Ms = match context
+ * Sz = size of field
+ * Operands: Fail Flags Dst
+ */
do_bs_get_integer_imm: {
- ErlBinMatchBuffer* mb;
- Eterm result;
+ ErlBinMatchBuffer* mb;
+ Eterm result;
- mb = ms_matchbuffer(tmp_arg1);
- LIGHT_SWAPOUT;
- result = erts_bs_get_integer_2(c_p, tmp_arg2, Arg(1), mb);
- LIGHT_SWAPIN;
- HEAP_SPACE_VERIFIED(0);
- if (is_non_value(result)) {
- ClauseFail();
+ mb = ms_matchbuffer(Ms);
+ LIGHT_SWAPOUT;
+ result = erts_bs_get_integer_2(c_p, Sz, Arg(1), mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(result)) {
+ ClauseFail();
+ }
+ StoreBifResult(2, result);
}
- StoreBifResult(2, result);
}
/*
- * tmp_arg1 = Match context
- * tmp_arg2 = Size field
- * Operands: Fail Live FlagsAndUnit Dst
+ * Operands: Fail Live FlagsAndUnit Ms Sz Dst
*/
- OpCase(i_bs_get_integer_fIId): {
+ OpCase(i_bs_get_integer_fIIssd): {
Uint flags;
Uint size;
+ Eterm Ms;
+ Eterm Sz;
ErlBinMatchBuffer* mb;
Eterm result;
flags = Arg(2);
- BsGetFieldSize(tmp_arg2, (flags >> 3), ClauseFail(), size);
+ GetArg2(3, Ms, Sz);
+ BsGetFieldSize(Sz, (flags >> 3), ClauseFail(), size);
if (size >= SMALL_BITS) {
Uint wordsneeded;
- /* check bits size before potential gc.
+ /* Check bits size before potential gc.
* We do not want a gc and then realize we don't need
- * the allocated space (i.e. if the op fails)
+ * the allocated space (i.e. if the op fails).
*
- * remember to reacquire the matchbuffer after gc.
+ * Remember to re-acquire the matchbuffer after gc.
*/
- mb = ms_matchbuffer(tmp_arg1);
+ mb = ms_matchbuffer(Ms);
if (mb->size - mb->offset < size) {
ClauseFail();
}
wordsneeded = 1+WSIZE(NBYTES((Uint) size));
- TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1);
+ TestHeapPreserve(wordsneeded, Arg(1), Ms);
}
- mb = ms_matchbuffer(tmp_arg1);
+ mb = ms_matchbuffer(Ms);
LIGHT_SWAPOUT;
result = erts_bs_get_integer_2(c_p, size, flags, mb);
LIGHT_SWAPIN;
@@ -4671,18 +4438,13 @@ do { \
if (is_non_value(result)) {
ClauseFail();
}
- StoreBifResult(3, result);
+ StoreBifResult(5, result);
}
{
Eterm get_utf8_context;
/* Operands: MatchContext Fail Dst */
- OpCase(i_bs_get_utf8_rfd): {
- get_utf8_context = r(0);
- goto do_bs_get_utf8;
- }
-
OpCase(i_bs_get_utf8_xfd): {
get_utf8_context = xb(Arg(0));
I++;
@@ -4693,7 +4455,7 @@ do { \
* Operands: Fail Dst
*/
- do_bs_get_utf8: {
+ {
Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context));
if (is_non_value(result)) {
ClauseFail();
@@ -4706,12 +4468,7 @@ do { \
Eterm get_utf16_context;
/* Operands: MatchContext Fail Flags Dst */
- OpCase(i_bs_get_utf16_rfId): {
- get_utf16_context = r(0);
- goto do_bs_get_utf16;
- }
-
- OpCase(i_bs_get_utf16_xfId): {
+ OpCase(i_bs_get_utf16_xfId): {
get_utf16_context = xb(Arg(0));
I++;
}
@@ -4720,7 +4477,7 @@ do { \
* get_utf16_context = match_context
* Operands: Fail Flags Dst
*/
- do_bs_get_utf16: {
+ {
Eterm result = erts_bs_get_utf16(ms_matchbuffer(get_utf16_context),
Arg(1));
if (is_non_value(result)) {
@@ -4739,26 +4496,10 @@ do { \
Uint orig;
Uint hole_size;
- OpCase(bs_context_to_binary_r): {
- context_to_binary_context = x0;
- I -= 2;
- goto do_context_to_binary;
- }
-
- /* Unfortunately, inlining can generate this instruction. */
- OpCase(bs_context_to_binary_y): {
- context_to_binary_context = yb(Arg(0));
- goto do_context_to_binary0;
- }
-
- OpCase(bs_context_to_binary_x): {
+ OpCase(bs_context_to_binary_x):
context_to_binary_context = xb(Arg(0));
-
- do_context_to_binary0:
I--;
- }
- do_context_to_binary:
if (is_boxed(context_to_binary_context) &&
header_is_bin_matchstate(*boxed_val(context_to_binary_context))) {
ErlBinMatchState* ms;
@@ -4770,17 +4511,11 @@ do { \
}
Next(2);
- OpCase(i_bs_get_binary_all_reuse_rfI): {
- context_to_binary_context = x0;
- goto do_bs_get_binary_all_reuse;
- }
-
OpCase(i_bs_get_binary_all_reuse_xfI): {
context_to_binary_context = xb(Arg(0));
I++;
}
- do_bs_get_binary_all_reuse:
mb = ms_matchbuffer(context_to_binary_context);
size = mb->size - mb->offset;
if (size % Arg(1) != 0) {
@@ -4808,16 +4543,11 @@ do { \
{
Eterm match_string_context;
- OpCase(i_bs_match_string_rfII): {
- match_string_context = r(0);
- goto do_bs_match_string;
- }
OpCase(i_bs_match_string_xfII): {
match_string_context = xb(Arg(0));
I++;
}
- do_bs_match_string:
{
BeamInstr *next;
byte* bytes;
@@ -4845,14 +4575,6 @@ do { \
}
}
- OpCase(i_bs_save2_rI): {
- BeamInstr *next;
- ErlBinMatchState *_ms;
- PreFetch(1, next);
- _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0));
- _ms->save_offset[Arg(0)] = _ms->mb.offset;
- NextPF(1, next);
- }
OpCase(i_bs_save2_xI): {
BeamInstr *next;
ErlBinMatchState *_ms;
@@ -4862,14 +4584,6 @@ do { \
NextPF(2, next);
}
- OpCase(i_bs_restore2_rI): {
- BeamInstr *next;
- ErlBinMatchState *_ms;
- PreFetch(1, next);
- _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0));
- _ms->mb.offset = _ms->save_offset[Arg(0)];
- NextPF(1, next);
- }
OpCase(i_bs_restore2_xI): {
BeamInstr *next;
ErlBinMatchState *_ms;
@@ -4917,9 +4631,7 @@ do { \
BeamInstr real_I;
ASSERT(I[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
SWAPOUT;
- reg[0] = r(0);
real_I = erts_generic_breakpoint(c_p, I, reg);
- r(0) = reg[0];
SWAPIN;
ASSERT(VALID_INSTR(real_I));
Goto(real_I);
@@ -4979,7 +4691,7 @@ do { \
BeamInstr *next;
PreFetch(2, next);
- GetR(0, targ1);
+ targ1 = REG_TARGET(Arg(0));
/* Arg(0) == HEADER_FLONUM */
GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr));
NextPF(2, next);
@@ -4999,7 +4711,7 @@ do { \
Eterm fr = Arg(1);
BeamInstr *next;
- GetR(0, targ1);
+ targ1 = REG_TARGET(Arg(0));
PreFetch(2, next);
if (is_small(targ1)) {
fb(fr) = (double) signed_val(targ1);
@@ -5095,7 +4807,12 @@ do { \
#ifdef HIPE
{
- unsigned cmd;
+#define HIPE_MODE_SWITCH(Cmd) \
+ SWAPOUT; \
+ c_p->fcalls = FCALLS; \
+ c_p->def_arg_reg[4] = -neg_o_reds; \
+ c_p = hipe_mode_switch(c_p, Cmd, reg); \
+ goto L_post_hipe_mode_switch
OpCase(hipe_trap_call): {
/*
@@ -5109,52 +4826,45 @@ do { \
*/
ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
c_p->hipe.u.ncallee = (void(*)(void)) I[-4];
- cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8);
++hipe_trap_count;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8));
}
OpCase(hipe_trap_call_closure): {
ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
c_p->hipe.u.ncallee = (void(*)(void)) I[-4];
- cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8);
++hipe_trap_count;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8));
}
OpCase(hipe_trap_return): {
- cmd = HIPE_MODE_SWITCH_CMD_RETURN;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN);
}
OpCase(hipe_trap_throw): {
- cmd = HIPE_MODE_SWITCH_CMD_THROW;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW);
}
OpCase(hipe_trap_resume): {
- cmd = HIPE_MODE_SWITCH_CMD_RESUME;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME);
}
- L_hipe_mode_switch:
- /* XXX: this abuse of def_arg_reg[] is horrid! */
- SWAPOUT;
- c_p->fcalls = FCALLS;
- c_p->def_arg_reg[4] = -neg_o_reds;
- reg[0] = r(0);
- c_p = hipe_mode_switch(c_p, cmd, reg);
+#undef HIPE_MODE_SWITCH
+
+ L_post_hipe_mode_switch:
reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
ERL_BITS_RELOAD_STATEP(c_p);
+ /* XXX: this abuse of def_arg_reg[] is horrid! */
neg_o_reds = -c_p->def_arg_reg[4];
FCALLS = c_p->fcalls;
SWAPIN;
- switch( c_p->def_arg_reg[3] ) { /* Halfword wont work with hipe yet! */
+ switch( c_p->def_arg_reg[3] ) {
case HIPE_MODE_SWITCH_RES_RETURN:
ASSERT(is_value(reg[0]));
- MoveReturn(reg[0], r(0));
+ SET_I(c_p->cp);
+ c_p->cp = 0;
+ Goto(*I);
case HIPE_MODE_SWITCH_RES_CALL_EXPORTED:
c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()];
/*fall through*/
case HIPE_MODE_SWITCH_RES_CALL_BEAM:
SET_I(c_p->i);
- r(0) = reg[0];
Dispatch();
case HIPE_MODE_SWITCH_RES_CALL_CLOSURE:
/* This can be used to call any function value, but currently it's
@@ -5163,9 +4873,8 @@ do { \
BeamInstr *next;
next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_I(next);
Dispatchfun();
}
@@ -5213,22 +4922,54 @@ do { \
}
OpCase(i_hibernate): {
- SWAPOUT;
+ HEAVY_SWAPOUT;
if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) {
+ FCALLS = c_p->fcalls;
c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
} else {
+ HEAVY_SWAPIN;
I = handle_error(c_p, I, reg, hibernate_3);
goto post_error_handling;
}
}
+ /* This is optimised as an instruction because
+ it has to be very very fast */
+ OpCase(i_perf_counter): {
+ BeamInstr* next;
+ ErtsSysPerfCounter ts;
+ PreFetch(0, next);
+
+ ts = erts_sys_perf_counter();
+
+ if (IS_SSMALL(ts)) {
+ r(0) = make_small((Sint)ts);
+ } else {
+ TestHeap(ERTS_SINT64_HEAP_SIZE(ts),0);
+ r(0) = make_big(HTOP);
+#if defined(ARCH_32) || HALFWORD_HEAP
+ if (ts >= (((Uint64) 1) << 32)) {
+ *HTOP = make_pos_bignum_header(2);
+ BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff));
+ BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff));
+ HTOP += 3;
+ }
+ else
+#endif
+ {
+ *HTOP = make_pos_bignum_header(1);
+ BIG_DIGIT(HTOP, 0) = (Uint) ts;
+ HTOP += 2;
+ }
+ }
+ NextPF(0, next);
+ }
+
OpCase(i_debug_breakpoint): {
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
I = call_error_handler(c_p, I-3, reg, am_breakpoint);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPIN;
if (I) {
Goto(*I);
}
@@ -6439,7 +6180,7 @@ call_fun(Process* p, /* Current process. */
*/
module = fe->module;
if ((modp = erts_get_module(module, code_ix)) != NULL
- && modp->curr.code != NULL) {
+ && modp->curr.code_hdr != NULL) {
/*
* There is a module loaded, but obviously the fun is not
* defined in it. We must not call the error_handler
@@ -6644,23 +6385,20 @@ static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx)
return vs ? *vs : THE_NON_VALUE;
}
-#define GET_TERM(term, dest) \
-do { \
- Eterm src = (Eterm)(term); \
- switch (src & _TAG_IMMED1_MASK) { \
- case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- dest = x(0); \
- break; \
- case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- dest = x(src >> _TAG_IMMED1_SIZE); \
- break; \
- case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- dest = y(src >> _TAG_IMMED1_SIZE); \
- break; \
- default: \
- dest = src; \
- break; \
- } \
+#define GET_TERM(term, dest) \
+do { \
+ Eterm src = (Eterm)(term); \
+ switch (loader_tag(src)) { \
+ case LOADER_X_REG: \
+ dest = x(loader_x_reg_index(src)); \
+ break; \
+ case LOADER_Y_REG: \
+ dest = y(loader_y_reg_index(src)); \
+ break; \
+ default: \
+ dest = src; \
+ break; \
+ } \
} while(0)
@@ -6699,13 +6437,6 @@ new_map(Process* p, Eterm* reg, BeamInstr* I)
erts_factory_proc_init(&factory, p);
res = erts_hashmap_from_array(&factory, thp, n/2, 0);
erts_factory_close(&factory);
- if (p->mbuf) {
- Uint live = Arg(2);
- reg[live] = res;
- erts_garbage_collect(p, 0, reg, live+1);
- res = reg[live];
- E = p->stop;
- }
return res;
}
@@ -6771,13 +6502,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
hx = hashmap_make_hash(new_key);
res = erts_hashmap_insert(p, hx, new_key, val, res, 0);
- if (p->mbuf) {
- Uint live = Arg(3);
- reg[live] = res;
- erts_garbage_collect(p, 0, reg, live+1);
- res = reg[live];
- E = p->stop;
- }
new_p += 2;
}
@@ -6937,12 +6661,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
/* The expensive case, need to build a hashmap */
if (n > MAP_SMALL_MAP_LIMIT) {
res = erts_hashmap_from_ks_and_vs(p,flatmap_get_keys(mp),flatmap_get_values(mp),n);
- if (p->mbuf) {
- Uint live = Arg(3);
- reg[live] = res;
- erts_garbage_collect(p, 0, reg, live+1);
- res = reg[live];
- }
}
return res;
}
@@ -6998,14 +6716,6 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
return res;
}
- if (p->mbuf) {
- Uint live = Arg(3);
- reg[live] = res;
- erts_garbage_collect(p, 0, reg, live+1);
- res = reg[live];
- E = p->stop;
- }
-
new_p += 2;
}
return res;
@@ -7114,6 +6824,15 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity)
Export e;
Export* ep;
+ if (Mod == am_erlang && Name == am_apply && arity == 3) {
+ /*
+ * Special case. apply/3 is built-in (implemented in C),
+ * but implemented in a different way than all other
+ * BIFs.
+ */
+ return 1;
+ }
+
e.code[0] = Mod;
e.code[1] = Name;
e.code[2] = arity;
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index a6dce2d1d2..1511a4f935 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -80,7 +80,7 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int);
typedef struct {
Uint value; /* Value of label (NULL if not known yet). */
- Uint patches; /* Index (into code buffer) to first location
+ Sint patches; /* Index (into code buffer) to first location
* which must be patched with the value of this label.
*/
#ifdef ERTS_SMP
@@ -284,9 +284,10 @@ typedef struct LoaderState {
int specific_op; /* Specific opcode (-1 if not found). */
int num_functions; /* Number of functions in module. */
int num_labels; /* Number of labels. */
- int code_buffer_size; /* Size of code buffer in words. */
- BeamInstr* code; /* Loaded code. */
- int ci; /* Current index into loaded code. */
+ BeamCodeHeader* hdr; /* Loaded code header */
+ BeamInstr* codev; /* Loaded code buffer */
+ int codev_size; /* Size of code buffer in words. */
+ int ci; /* Current index into loaded code buffer. */
Label* labels;
StringPatch* string_patches; /* Linked list of position into string table to patch. */
BeamInstr catches; /* Linked list of catch_yf instructions. */
@@ -480,7 +481,7 @@ static void free_literal_fragment(ErlHeapFragment*);
static void loader_state_dtor(Binary* magic);
static Eterm insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
Eterm group_leader, Eterm module,
- BeamInstr* code, Uint size);
+ BeamCodeHeader* code, Uint size);
static int init_iff_file(LoaderState* stp, byte* code, Uint size);
static int scan_iff_file(LoaderState* stp, Uint* chunk_types,
Uint num_types, Uint num_mandatory);
@@ -526,15 +527,15 @@ static void new_string_patch(LoaderState* stp, int pos);
static Uint new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size);
static int genopargcompare(GenOpArg* a, GenOpArg* b);
static Eterm get_module_info(Process* p, ErtsCodeIndex code_ix,
- BeamInstr* code, Eterm module, Eterm what);
+ BeamCodeHeader*, Eterm module, Eterm what);
static Eterm exported_from_module(Process* p, ErtsCodeIndex code_ix,
Eterm mod);
-static Eterm functions_in_module(Process* p, BeamInstr* code);
-static Eterm attributes_for_module(Process* p, BeamInstr* code);
-static Eterm compilation_info_for_module(Process* p, BeamInstr* code);
-static Eterm md5_of_module(Process* p, BeamInstr* code);
-static Eterm has_native(BeamInstr* code);
-static Eterm native_addresses(Process* p, BeamInstr* code);
+static Eterm functions_in_module(Process* p, BeamCodeHeader*);
+static Eterm attributes_for_module(Process* p, BeamCodeHeader*);
+static Eterm compilation_info_for_module(Process* p, BeamCodeHeader*);
+static Eterm md5_of_module(Process* p, BeamCodeHeader*);
+static Eterm has_native(BeamCodeHeader*);
+static Eterm native_addresses(Process* p, BeamCodeHeader*);
int patch_funentries(Eterm Patchlist);
int patch(Eterm Addresses, Uint fe);
static int safe_mul(UWord a, UWord b, UWord* resp);
@@ -601,6 +602,7 @@ extern void check_allocated_block(Uint type, void *blk);
#define CHKBLK(TYPE,BLK) /* nothing */
#endif
+
Eterm
erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
Eterm* modp, byte* code, Uint unloaded_size)
@@ -641,20 +643,27 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
/*
* Initialize code area.
*/
- stp->code_buffer_size = 2048 + stp->num_functions;
- stp->code = (BeamInstr *) erts_alloc(ERTS_ALC_T_CODE,
- sizeof(BeamInstr) * stp->code_buffer_size);
+ stp->codev_size = 2048 + stp->num_functions;
+ stp->hdr = (BeamCodeHeader*) erts_alloc(ERTS_ALC_T_CODE,
+ (offsetof(BeamCodeHeader,functions)
+ + sizeof(BeamInstr) * stp->codev_size));
- stp->code[MI_NUM_FUNCTIONS] = stp->num_functions;
- stp->ci = MI_FUNCTIONS + stp->num_functions + 1;
+ stp->hdr->num_functions = stp->num_functions;
- stp->code[MI_ATTR_PTR] = 0;
- stp->code[MI_ATTR_SIZE] = 0;
- stp->code[MI_ATTR_SIZE_ON_HEAP] = 0;
- stp->code[MI_COMPILE_PTR] = 0;
- stp->code[MI_COMPILE_SIZE] = 0;
- stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0;
- stp->code[MI_MD5_PTR] = 0;
+ /* Let the codev array start at functions[0] in order to index
+ * both function pointers and the loaded code itself that follows.
+ */
+ stp->codev = (BeamInstr*) &stp->hdr->functions;
+ stp->ci = stp->num_functions + 1;
+
+ stp->hdr->attr_ptr = NULL;
+ stp->hdr->attr_size = 0;
+ stp->hdr->attr_size_on_heap = 0;
+ stp->hdr->compile_ptr = NULL;
+ stp->hdr->compile_size = 0;
+ stp->hdr->compile_size_on_heap = 0;
+ stp->hdr->literals_start = NULL;
+ stp->hdr->md5_ptr = NULL;
/*
* Read the atom table.
@@ -776,7 +785,7 @@ erts_finish_loading(Binary* magic, Process* c_p,
CHKBLK(ERTS_ALC_T_CODE,stp->code);
retval = insert_new_code(c_p, c_p_locks, stp->group_leader, stp->module,
- stp->code, stp->loaded_size);
+ stp->hdr, stp->loaded_size);
if (retval != NIL) {
goto load_error;
}
@@ -799,7 +808,8 @@ erts_finish_loading(Binary* magic, Process* c_p,
debug_dump_code(stp->code,stp->ci);
#endif
#endif
- stp->code = NULL; /* Prevent code from being freed. */
+ stp->hdr = NULL; /* Prevent code from being freed. */
+ stp->codev = NULL;
*modp = stp->module;
/*
@@ -831,7 +841,8 @@ erts_alloc_loader_state(void)
stp->specific_op = -1;
stp->genop = NULL;
stp->atom = NULL;
- stp->code = NULL;
+ stp->hdr = NULL;
+ stp->codev = NULL;
stp->labels = NULL;
stp->import = NULL;
stp->export = NULL;
@@ -870,7 +881,7 @@ erts_module_for_prepared_code(Binary* magic)
return NIL;
}
stp = ERTS_MAGIC_BIN_DATA(magic);
- if (stp->code != 0) {
+ if (stp->hdr != 0) {
return stp->module;
} else {
return NIL;
@@ -891,7 +902,7 @@ static ErlHeapFragment* new_literal_fragment(Uint size)
ErlHeapFragment* bp;
bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_PREPARED_CODE,
ERTS_HEAP_FRAG_SIZE(size));
- ERTS_INIT_HEAP_FRAG(bp, size);
+ ERTS_INIT_HEAP_FRAG(bp, size, size);
return bp;
}
@@ -920,9 +931,13 @@ loader_state_dtor(Binary* magic)
driver_free_binary(stp->bin);
stp->bin = 0;
}
- if (stp->code != 0) {
- erts_free(ERTS_ALC_T_CODE, stp->code);
- stp->code = 0;
+ if (stp->hdr != 0) {
+ if (stp->hdr->literals_start) {
+ erts_free(ERTS_ALC_T_LITERAL, stp->hdr->literals_start);
+ }
+ erts_free(ERTS_ALC_T_CODE, stp->hdr);
+ stp->hdr = 0;
+ stp->codev = 0;
}
if (stp->labels != 0) {
erts_free(ERTS_ALC_T_PREPARED_CODE, (void *) stp->labels);
@@ -995,7 +1010,7 @@ loader_state_dtor(Binary* magic)
static Eterm
insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm module, BeamInstr* code,
+ Eterm group_leader, Eterm module, BeamCodeHeader* code_hdr,
Uint size)
{
Module* modp;
@@ -1016,7 +1031,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
erts_total_code_size += size;
modp = erts_put_module(module);
- modp->curr.code = code;
+ modp->curr.code_hdr = code_hdr;
modp->curr.code_length = size;
modp->curr.catches = BEAM_CATCHES_NIL; /* Will be filled in later. */
@@ -1024,7 +1039,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
* Update ranges (used for finding a function from a PC value).
*/
- erts_update_ranges(code, size);
+ erts_update_ranges((BeamInstr*)modp->curr.code_hdr, size);
return NIL;
}
@@ -1373,7 +1388,7 @@ read_export_table(LoaderState* stp)
if (value == 0) {
LoadError2(stp, "export table entry %d: label %d not resolved", i, n);
}
- stp->export[i].address = address = stp->code + value;
+ stp->export[i].address = address = stp->codev + value;
/*
* Find out if there is a BIF with the same name.
@@ -1392,7 +1407,7 @@ read_export_table(LoaderState* stp)
* any other functions that walk through all local functions.
*/
- if (stp->labels[n].patches) {
+ if (stp->labels[n].patches >= 0) {
LoadError3(stp, "there are local calls to the stub for "
"the BIF %T:%T/%d",
stp->module, func, arity);
@@ -1513,8 +1528,8 @@ read_literal_table(LoaderState* stp)
}
if (heap_size > 0) {
- erts_factory_message_init(&factory, NULL, NULL,
- new_literal_fragment(heap_size));
+ erts_factory_heap_frag_init(&factory,
+ new_literal_fragment(heap_size));
factory.alloc_type = ERTS_ALC_T_PREPARED_CODE;
val = erts_decode_ext(&factory, &p);
@@ -1735,7 +1750,7 @@ read_code_header(LoaderState* stp)
stp->num_labels * sizeof(Label));
for (i = 0; i < stp->num_labels; i++) {
stp->labels[i].value = 0;
- stp->labels[i].patches = 0;
+ stp->labels[i].patches = -1;
#ifdef ERTS_SMP
stp->labels[i].looprec_targeted = 0;
#endif
@@ -1754,13 +1769,14 @@ read_code_header(LoaderState* stp)
} else {}
#define CodeNeed(w) do { \
- ASSERT(ci <= code_buffer_size); \
- if (code_buffer_size < ci+(w)) { \
- code_buffer_size = 2*ci+(w); \
- stp->code = code = \
- (BeamInstr *) erts_realloc(ERTS_ALC_T_CODE, \
- (void *) code, \
- code_buffer_size * sizeof(BeamInstr)); \
+ ASSERT(ci <= codev_size); \
+ if (codev_size < ci+(w)) { \
+ codev_size = 2*ci+(w); \
+ stp->hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE, \
+ (void *) stp->hdr, \
+ (offsetof(BeamCodeHeader,functions) \
+ + codev_size * sizeof(BeamInstr))); \
+ code = stp->codev = (BeamInstr*) &stp->hdr->functions; \
} \
} while (0)
@@ -1776,7 +1792,7 @@ load_code(LoaderState* stp)
int arg; /* Number of current argument. */
int num_specific; /* Number of specific ops for current. */
BeamInstr* code;
- int code_buffer_size;
+ int codev_size;
int specific;
Uint last_label = 0; /* Number of last label. */
Uint function_number = 0;
@@ -1793,15 +1809,15 @@ load_code(LoaderState* stp)
FUNC_INFO_SZ = 5
};
- code = stp->code;
- code_buffer_size = stp->code_buffer_size;
+ code = stp->codev;
+ codev_size = stp->codev_size;
ci = stp->ci;
for (;;) {
int new_op;
GenOp* tmp_op;
- ASSERT(ci <= code_buffer_size);
+ ASSERT(ci <= codev_size);
get_next_instr:
GetByte(stp, new_op);
@@ -1847,9 +1863,7 @@ load_code(LoaderState* stp)
case TAG_o:
break;
case TAG_x:
- if (last_op->a[arg].val == 0) {
- last_op->a[arg].type = TAG_r;
- } else if (last_op->a[arg].val >= MAX_REG) {
+ if (last_op->a[arg].val >= MAX_REG) {
LoadError1(stp, "invalid x register number: %u",
last_op->a[arg].val);
}
@@ -1894,15 +1908,14 @@ load_code(LoaderState* stp)
*/
{
Eterm* hp;
-/* XXX:PaN - Halfword should use ARCH_64 variant instead */
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
Uint high, low;
# endif
last_op->a[arg].val = new_literal(stp, &hp,
FLOAT_SIZE_OBJECT);
hp[0] = HEADER_FLONUM;
last_op->a[arg].type = TAG_q;
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
GetInt(stp, 8, hp[1]);
# else
GetInt(stp, 4, high);
@@ -2056,7 +2069,42 @@ load_code(LoaderState* stp)
if (((opc[specific].mask[0] & mask[0]) == mask[0]) &&
((opc[specific].mask[1] & mask[1]) == mask[1]) &&
((opc[specific].mask[2] & mask[2]) == mask[2])) {
- break;
+
+ if (!opc[specific].involves_r) {
+ break; /* No complications - match */
+ }
+
+ /*
+ * The specific operation uses the 'r' operand,
+ * which is shorthand for x(0). Now things
+ * get complicated. First we must check whether
+ * all operands that should be of type 'r' use
+ * x(0) (as opposed to some other X register).
+ */
+ for (arg = 0; arg < arity; arg++) {
+ if (opc[specific].involves_r & (1 << arg) &&
+ tmp_op->a[arg].type == TAG_x) {
+ if (tmp_op->a[arg].val != 0) {
+ break; /* Other X register than 0 */
+ }
+ }
+ }
+
+ if (arg == arity) {
+ /*
+ * All 'r' operands use x(0) in the generic
+ * operation. That means a match. Now we
+ * will need to rewrite the generic instruction
+ * to actually use 'r' instead of 'x(0)'.
+ */
+ for (arg = 0; arg < arity; arg++) {
+ if (opc[specific].involves_r & (1 << arg) &&
+ tmp_op->a[arg].type == TAG_x) {
+ tmp_op->a[arg].type = TAG_r;
+ }
+ }
+ break; /* Match */
+ }
}
specific++;
}
@@ -2167,14 +2215,11 @@ load_code(LoaderState* stp)
break;
case 's': /* Any source (tagged constant or register) */
switch (tag) {
- case TAG_r:
- code[ci++] = make_rreg();
- break;
case TAG_x:
- code[ci++] = make_xreg(tmp_op->a[arg].val);
+ code[ci++] = make_loader_x_reg(tmp_op->a[arg].val);
break;
case TAG_y:
- code[ci++] = make_yreg(tmp_op->a[arg].val);
+ code[ci++] = make_loader_y_reg(tmp_op->a[arg].val);
break;
case TAG_i:
code[ci++] = (BeamInstr) make_small((Uint)tmp_op->a[arg].val);
@@ -2185,6 +2230,10 @@ load_code(LoaderState* stp)
case TAG_n:
code[ci++] = NIL;
break;
+ case TAG_q:
+ new_literal_patch(stp, ci);
+ code[ci++] = tmp_op->a[arg].val;
+ break;
default:
LoadError1(stp, "bad tag %d for general source",
tmp_op->a[arg].type);
@@ -2193,14 +2242,11 @@ load_code(LoaderState* stp)
break;
case 'd': /* Destination (x(0), x(N), y(N) */
switch (tag) {
- case TAG_r:
- code[ci++] = make_rreg();
- break;
case TAG_x:
- code[ci++] = make_xreg(tmp_op->a[arg].val);
+ code[ci++] = tmp_op->a[arg].val * sizeof(Eterm);
break;
case TAG_y:
- code[ci++] = make_yreg(tmp_op->a[arg].val);
+ code[ci++] = tmp_op->a[arg].val * sizeof(Eterm) + 1;
break;
default:
LoadError1(stp, "bad tag %d for destination",
@@ -2357,20 +2403,13 @@ load_code(LoaderState* stp)
stp->labels[tmp_op->a[arg].val].patches = ci;
ci++;
break;
- case TAG_r:
- CodeNeed(1);
- code[ci++] = (R_REG_DEF << _TAG_PRIMARY_SIZE) |
- TAG_PRIMARY_HEADER;
- break;
case TAG_x:
CodeNeed(1);
- code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) |
- (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER;
+ code[ci++] = make_loader_x_reg(tmp_op->a[arg].val);
break;
case TAG_y:
CodeNeed(1);
- code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) |
- (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER;
+ code[ci++] = make_loader_y_reg(tmp_op->a[arg].val);
break;
case TAG_n:
CodeNeed(1);
@@ -2393,8 +2432,7 @@ load_code(LoaderState* stp)
switch (stp->specific_op) {
case op_i_func_info_IaaI:
{
- Uint offset;
-
+ Sint offset;
if (function_number >= stp->num_functions) {
LoadError1(stp, "too many functions in module (header said %d)",
stp->num_functions);
@@ -2436,15 +2474,15 @@ load_code(LoaderState* stp)
stp->arity = code[ci-1];
ASSERT(stp->labels[last_label].value == ci - FUNC_INFO_SZ);
- offset = MI_FUNCTIONS + function_number;
- code[offset] = stp->labels[last_label].patches;
+ stp->hdr->functions[function_number] = (BeamInstr*) stp->labels[last_label].patches;
+ offset = function_number;
stp->labels[last_label].patches = offset;
function_number++;
if (stp->arity > MAX_ARG) {
LoadError1(stp, "too many arguments: %d", stp->arity);
}
#ifdef DEBUG
- ASSERT(stp->labels[0].patches == 0); /* Should not be referenced. */
+ ASSERT(stp->labels[0].patches < 0); /* Should not be referenced. */
for (i = 1; i < stp->num_labels; i++) {
ASSERT(stp->labels[i].patches < ci);
}
@@ -2458,7 +2496,6 @@ load_code(LoaderState* stp)
stp->on_load = ci;
break;
case op_bs_put_string_II:
- case op_i_bs_match_string_rfII:
case op_i_bs_match_string_xfII:
new_string_patch(stp, ci-1);
break;
@@ -2515,7 +2552,7 @@ load_code(LoaderState* stp)
* End of code found.
*/
case op_int_code_end:
- stp->code_buffer_size = code_buffer_size;
+ stp->codev_size = codev_size;
stp->ci = ci;
stp->function = THE_NON_VALUE;
stp->genop = NULL;
@@ -2680,6 +2717,12 @@ same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label)
Target.val == Label.val;
}
+static int
+is_killed(LoaderState* stp, GenOpArg Reg, GenOpArg Live)
+{
+ return Reg.type == TAG_x && Live.type == TAG_u &&
+ Live.val <= Reg.val;
+}
/*
* Generate an instruction for element/2.
@@ -2696,17 +2739,17 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index,
op->next = NULL;
if (Index.type == TAG_i && Index.val > 0 &&
- (Tuple.type == TAG_r || Tuple.type == TAG_x || Tuple.type == TAG_y)) {
+ (Tuple.type == TAG_x || Tuple.type == TAG_y)) {
op->op = genop_i_fast_element_4;
- op->a[0] = Tuple;
- op->a[1] = Fail;
+ op->a[0] = Fail;
+ op->a[1] = Tuple;
op->a[2].type = TAG_u;
op->a[2].val = Index.val;
op->a[3] = Dst;
} else {
op->op = genop_i_element_4;
- op->a[0] = Tuple;
- op->a[1] = Fail;
+ op->a[0] = Fail;
+ op->a[1] = Tuple;
op->a[2] = Index;
op->a[3] = Dst;
}
@@ -2832,23 +2875,16 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
goto generic;
}
} else {
- GenOp* op2;
- NEW_GENOP(stp, op2);
-
- op->op = genop_i_fetch_2;
- op->arity = 2;
- op->a[0] = Ms;
- op->a[1] = Size;
- op->next = op2;
-
- op2->op = genop_i_bs_get_integer_4;
- op2->arity = 4;
- op2->a[0] = Fail;
- op2->a[1] = Live;
- op2->a[2].type = TAG_u;
- op2->a[2].val = (Unit.val << 3) | Flags.val;
- op2->a[3] = Dst;
- op2->next = NULL;
+ op->op = genop_i_bs_get_integer_6;
+ op->arity = 6;
+ op->a[0] = Fail;
+ op->a[1] = Live;
+ op->a[2].type = TAG_u;
+ op->a[2].val = (Unit.val << 3) | Flags.val;
+ op->a[3] = Ms;
+ op->a[4] = Size;
+ op->a[5] = Dst;
+ op->next = NULL;
return op;
}
op->next = NULL;
@@ -3272,14 +3308,14 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
op->a[1].type = TAG_u;
if (Time.type == TAG_i && (timeout = Time.val) >= 0 &&
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
(timeout >> 32) == 0
#else
1
#endif
) {
op->a[1].val = timeout;
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
} else if (Time.type == TAG_q) {
Eterm big;
@@ -3296,7 +3332,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
}
#endif
} else {
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
error:
#endif
op->op = genop_i_wait_error_0;
@@ -3319,14 +3355,14 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
op->a[1].type = TAG_u;
if (Time.type == TAG_i && (timeout = Time.val) >= 0 &&
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
(timeout >> 32) == 0
#else
1
#endif
) {
op->a[1].val = timeout;
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
} else if (Time.type == TAG_q) {
Eterm big;
@@ -3343,7 +3379,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
}
#endif
} else {
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
error:
#endif
op->op = genop_i_wait_error_locked_0;
@@ -3899,9 +3935,7 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx)
/*
* Rewrite gc_bifs with one parameter (the common case). Utilized
* in ops.tab to rewrite instructions calling bif's in guards
- * to use a garbage collecting implementation. The instructions
- * are sometimes once again rewritten to handle literals (putting the
- * parameter in the mostly unused r[0] before the instruction is executed).
+ * to use a garbage collecting implementation.
*/
static GenOp*
gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
@@ -3956,10 +3990,6 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
/*
* This is used by the ops.tab rule that rewrites gc_bifs with two parameters.
- * The instruction returned is then again rewritten to an i_load instruction
- * followed by i_gc_bif2_jIId, to handle literals properly.
- * As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is
- * always rewritten, regardless of if there actually are any literals.
*/
static GenOp*
gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
@@ -3986,23 +4016,19 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
op->a[2].val = stp->import[Bif.val].arity;
return op;
}
- op->op = genop_ii_gc_bif2_6;
+ op->op = genop_i_gc_bif2_6;
op->arity = 6;
op->a[0] = Fail;
op->a[1].type = TAG_u;
- op->a[2] = S1;
- op->a[3] = S2;
- op->a[4] = Live;
+ op->a[2] = Live;
+ op->a[3] = S1;
+ op->a[4] = S2;
op->a[5] = Dst;
return op;
}
/*
* This is used by the ops.tab rule that rewrites gc_bifs with three parameters.
- * The instruction returned is then again rewritten to a move instruction that
- * uses r[0] for temp storage, followed by an i_load instruction,
- * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting
- * always occur, as with the gc_bif2 counterpart.
*/
static GenOp*
gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
@@ -4033,10 +4059,10 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
op->arity = 7;
op->a[0] = Fail;
op->a[1].type = TAG_u;
- op->a[2] = S1;
- op->a[3] = S2;
- op->a[4] = S3;
- op->a[5] = Live;
+ op->a[2] = Live;
+ op->a[3] = S1;
+ op->a[4] = S2;
+ op->a[5] = S3;
op->a[6] = Dst;
op->next = NULL;
return op;
@@ -4258,6 +4284,53 @@ gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
return op;
}
+static int
+hash_internal_genop_arg(LoaderState* stp, GenOpArg Key, Uint32* hx)
+{
+ switch (Key.type) {
+ case TAG_a:
+ *hx = atom_tab(atom_val(Key.val))->slot.bucket.hvalue;
+ return 1;
+ case TAG_i:
+ *hx = Key.val;
+ return 1;
+ case TAG_n:
+ *hx = make_internal_hash(NIL);
+ return 1;
+ case TAG_q:
+ *hx = make_internal_hash(stp->literals[Key.val].term);
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+
+static GenOp*
+gen_get(LoaderState* stp, GenOpArg Src, GenOpArg Dst)
+{
+ GenOp* op;
+ Uint32 hx = 0;
+
+ NEW_GENOP(stp, op);
+ op->next = NULL;
+ if (hash_internal_genop_arg(stp, Src, &hx)) {
+ op->arity = 3;
+ op->op = genop_i_get_hash_3;
+ op->a[0] = Src;
+ op->a[1].type = TAG_u;
+ op->a[1].val = (BeamInstr) hx;
+ op->a[2] = Dst;
+ } else {
+ op->arity = 2;
+ op->op = genop_i_get_2;
+ op->a[0] = Src;
+ op->a[1] = Dst;
+ }
+ return op;
+}
+
+
static GenOp*
gen_get_map_elements(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
GenOpArg Size, GenOpArg* Rest)
@@ -4323,7 +4396,7 @@ gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
for (i = 0; i < n; i++) {
op->a[3+2*i] = Rest[i];
op->a[3+2*i+1].type = TAG_x;
- op->a[3+2*i+1].val = 0; /* x(0); normally not used */
+ op->a[3+2*i+1].val = SCRATCH_X_REG; /* Ignore result */
}
return op;
}
@@ -4336,8 +4409,8 @@ gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
static int
freeze_code(LoaderState* stp)
{
- BeamInstr* code = stp->code;
- Uint *literal_end = NULL;
+ BeamCodeHeader* code_hdr = stp->hdr;
+ BeamInstr* codev = (BeamInstr*) &stp->hdr->functions;
int i;
byte* str_table;
unsigned strtab_size = stp->chunks[STR_CHUNK].size;
@@ -4362,77 +4435,76 @@ freeze_code(LoaderState* stp)
if (stp->line_instr == 0) {
line_size = 0;
} else {
- line_size = (MI_LINE_FUNC_TAB + (stp->num_functions + 1) +
- (stp->current_li+1) + stp->num_fnames) *
- sizeof(Eterm) + (stp->current_li+1) * stp->loc_size;
+ line_size = (offsetof(BeamCodeLineTab,func_tab)
+ + (stp->num_functions + 1) * sizeof(BeamInstr**) /* func_tab */
+ + (stp->current_li + 1) * sizeof(BeamInstr*) /* line items */
+ + stp->num_fnames * sizeof(Eterm) /* fname table */
+ + (stp->current_li + 1) * stp->loc_size); /* loc_tab */
}
- size = (stp->ci * sizeof(BeamInstr)) +
- (stp->total_literal_size * sizeof(Eterm)) +
+ size = offsetof(BeamCodeHeader,functions) + (stp->ci * sizeof(BeamInstr)) +
strtab_size + attr_size + compile_size + MD5_SIZE + line_size;
/*
* Move the code to its final location.
*/
- code = (BeamInstr *) erts_realloc(ERTS_ALC_T_CODE, (void *) code, size);
- CHKBLK(ERTS_ALC_T_CODE,code);
+ code_hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE, (void *) code_hdr, size);
+ codev = (BeamInstr*) &code_hdr->functions;
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
/*
* Place a pointer to the op_int_code_end instruction in the
* function table in the beginning of the file.
*/
- code[MI_FUNCTIONS+stp->num_functions] = (BeamInstr) (code + stp->ci - 1);
- CHKBLK(ERTS_ALC_T_CODE,code);
+ code_hdr->functions[stp->num_functions] = (codev + stp->ci - 1);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
/*
* Store the pointer to the on_load function.
*/
if (stp->on_load) {
- code[MI_ON_LOAD_FUNCTION_PTR] = (BeamInstr) (code + stp->on_load);
+ code_hdr->on_load_function_ptr = codev + stp->on_load;
} else {
- code[MI_ON_LOAD_FUNCTION_PTR] = 0;
+ code_hdr->on_load_function_ptr = NULL;
}
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
- literal_end = (Uint *) (code+stp->ci);
/*
- * Place the literal heap directly after the code and fix up all
- * instructions that refer to it.
+ * Place the literals in their own allocated heap (for fast range check)
+ * and fix up all instructions that refer to it.
*/
{
- Uint* ptr;
- Uint* low;
- Uint* high;
+ Eterm* ptr;
LiteralPatch* lp;
ErlOffHeap code_off_heap;
ERTS_INIT_OFF_HEAP(&code_off_heap);
- low = (Uint *) (code+stp->ci);
- high = low + stp->total_literal_size;
- code[MI_LITERALS_START] = (BeamInstr) low;
- code[MI_LITERALS_END] = (BeamInstr) high;
- ptr = low;
+ ptr = (Eterm*)erts_alloc(ERTS_ALC_T_LITERAL,
+ stp->total_literal_size*sizeof(Eterm));
+ code_hdr->literals_start = ptr;
+ code_hdr->literals_end = ptr + stp->total_literal_size;
for (i = 0; i < stp->num_literals; i++) {
- if (stp->literals[i].heap_frags) {
- move_multi_frags(&ptr, &code_off_heap, stp->literals[i].heap_frags,
- &stp->literals[i].term, 1);
+ if (is_not_immed(stp->literals[i].term)) {
+ erts_move_multi_frags(&ptr, &code_off_heap,
+ stp->literals[i].heap_frags,
+ &stp->literals[i].term, 1, 1);
+ ASSERT(erts_is_literal(stp->literals[i].term,
+ ptr_val(stp->literals[i].term)));
}
- else ASSERT(is_immed(stp->literals[i].term));
}
- code[MI_LITERALS_OFF_HEAP] = (BeamInstr) code_off_heap.first;
+ code_hdr->literals_off_heap = code_off_heap.first;
lp = stp->literal_patches;
while (lp != 0) {
BeamInstr* op_ptr;
Literal* lit;
- op_ptr = code + lp->pos;
+ op_ptr = codev + lp->pos;
lit = &stp->literals[op_ptr[0]];
op_ptr[0] = lit->term;
lp = lp->next;
}
- literal_end += stp->total_literal_size;
}
CHKBLK(ERTS_ALC_T_CODE,code);
@@ -4440,52 +4512,49 @@ freeze_code(LoaderState* stp)
* If there is line information, place it here.
*/
if (stp->line_instr == 0) {
- code[MI_LINE_TABLE] = (BeamInstr) 0;
- str_table = (byte *) literal_end;
+ code_hdr->line_table = NULL;
+ str_table = (byte *) (codev + stp->ci);
} else {
- Eterm* line_tab = (Eterm *) literal_end;
- Eterm* p;
- int ftab_size = stp->num_functions;
- int num_instrs = stp->current_li;
- Eterm* first_line_item;
+ BeamCodeLineTab* const line_tab = (BeamCodeLineTab *) (codev+stp->ci);
+ const int ftab_size = stp->num_functions;
+ const int num_instrs = stp->current_li;
+ const BeamInstr** const line_items =
+ (const BeamInstr**) &line_tab->func_tab[ftab_size + 1];
- code[MI_LINE_TABLE] = (BeamInstr) line_tab;
- p = line_tab + MI_LINE_FUNC_TAB;
+ code_hdr->line_table = line_tab;
- first_line_item = (p + ftab_size + 1);
for (i = 0; i < ftab_size; i++) {
- *p++ = (Eterm) (BeamInstr) (first_line_item + stp->func_line[i]);
+ line_tab->func_tab[i] = line_items + stp->func_line[i];
}
- *p++ = (Eterm) (BeamInstr) (first_line_item + num_instrs);
- ASSERT(p == first_line_item);
+ line_tab->func_tab[i] = line_items + num_instrs;
+
for (i = 0; i < num_instrs; i++) {
- *p++ = (Eterm) (BeamInstr) (code + stp->line_instr[i].pos);
+ line_items[i] = codev + stp->line_instr[i].pos;
}
- *p++ = (Eterm) (BeamInstr) (code + stp->ci - 1);
+ line_items[i] = codev + stp->ci - 1;
- line_tab[MI_LINE_FNAME_PTR] = (Eterm) (BeamInstr) p;
- memcpy(p, stp->fname, stp->num_fnames*sizeof(Eterm));
- p += stp->num_fnames;
+ line_tab->fname_ptr = (Eterm*) &line_items[i + 1];
+ memcpy(line_tab->fname_ptr, stp->fname, stp->num_fnames*sizeof(Eterm));
- line_tab[MI_LINE_LOC_TAB] = (Eterm) (BeamInstr) p;
- line_tab[MI_LINE_LOC_SIZE] = stp->loc_size;
+ line_tab->loc_size = stp->loc_size;
if (stp->loc_size == 2) {
- Uint16* locp = (Uint16 *) p;
- for (i = 0; i < num_instrs; i++) {
+ Uint16* locp = (Uint16 *) &line_tab->fname_ptr[stp->num_fnames];
+ line_tab->loc_tab.p2 = locp;
+ for (i = 0; i < num_instrs; i++) {
*locp++ = (Uint16) stp->line_instr[i].loc;
- }
- *locp++ = LINE_INVALID_LOCATION;
- str_table = (byte *) locp;
+ }
+ *locp++ = LINE_INVALID_LOCATION;
+ str_table = (byte *) locp;
} else {
- Uint32* locp = (Uint32 *) p;
- ASSERT(stp->loc_size == 4);
+ Uint32* locp = (Uint32 *) &line_tab->fname_ptr[stp->num_fnames];
+ ASSERT(stp->loc_size == 4);
+ line_tab->loc_tab.p4 = locp;
for (i = 0; i < num_instrs; i++) {
*locp++ = stp->line_instr[i].loc;
}
*locp++ = LINE_INVALID_LOCATION;
- str_table = (byte *) locp;
+ str_table = (byte *) locp;
}
-
CHKBLK(ERTS_ALC_T_CODE,code);
}
@@ -4497,13 +4566,13 @@ freeze_code(LoaderState* stp)
if (attr_size) {
byte* attr = str_table + strtab_size;
sys_memcpy(attr, stp->chunks[ATTR_CHUNK].start, stp->chunks[ATTR_CHUNK].size);
- code[MI_ATTR_PTR] = (BeamInstr) attr;
- code[MI_ATTR_SIZE] = (BeamInstr) stp->chunks[ATTR_CHUNK].size;
+ code_hdr->attr_ptr = attr;
+ code_hdr->attr_size = (BeamInstr) stp->chunks[ATTR_CHUNK].size;
decoded_size = erts_decode_ext_size(attr, attr_size);
if (decoded_size < 0) {
LoadError0(stp, "bad external term representation of module attributes");
}
- code[MI_ATTR_SIZE_ON_HEAP] = decoded_size;
+ code_hdr->attr_size_on_heap = decoded_size;
}
CHKBLK(ERTS_ALC_T_CODE,code);
if (compile_size) {
@@ -4513,9 +4582,9 @@ freeze_code(LoaderState* stp)
stp->chunks[COMPILE_CHUNK].size);
CHKBLK(ERTS_ALC_T_CODE,code);
- code[MI_COMPILE_PTR] = (BeamInstr) compile_info;
+ code_hdr->compile_ptr = compile_info;
CHKBLK(ERTS_ALC_T_CODE,code);
- code[MI_COMPILE_SIZE] = (BeamInstr) stp->chunks[COMPILE_CHUNK].size;
+ code_hdr->compile_size = (BeamInstr) stp->chunks[COMPILE_CHUNK].size;
CHKBLK(ERTS_ALC_T_CODE,code);
decoded_size = erts_decode_ext_size(compile_info, compile_size);
CHKBLK(ERTS_ALC_T_CODE,code);
@@ -4523,7 +4592,7 @@ freeze_code(LoaderState* stp)
LoadError0(stp, "bad external term representation of compilation information");
}
CHKBLK(ERTS_ALC_T_CODE,code);
- code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size;
+ code_hdr->compile_size_on_heap = decoded_size;
}
CHKBLK(ERTS_ALC_T_CODE,code);
{
@@ -4531,7 +4600,7 @@ freeze_code(LoaderState* stp)
CHKBLK(ERTS_ALC_T_CODE,code);
sys_memcpy(md5_sum, stp->mod_md5, MD5_SIZE);
CHKBLK(ERTS_ALC_T_CODE,code);
- code[MI_MD5_PTR] = (BeamInstr) md5_sum;
+ code_hdr->md5_ptr = md5_sum;
CHKBLK(ERTS_ALC_T_CODE,code);
}
CHKBLK(ERTS_ALC_T_CODE,code);
@@ -4540,7 +4609,7 @@ freeze_code(LoaderState* stp)
* Make sure that we have not overflowed the allocated code space.
*/
ASSERT(str_table + strtab_size + attr_size + compile_size + MD5_SIZE ==
- ((byte *) code) + size);
+ ((byte *) code_hdr) + size);
/*
* Patch all instructions that refer to the string table.
@@ -4552,46 +4621,47 @@ freeze_code(LoaderState* stp)
BeamInstr* op_ptr;
byte* strp;
- op_ptr = code + sp->pos;
+ op_ptr = codev + sp->pos;
strp = str_table + op_ptr[0];
op_ptr[0] = (BeamInstr) strp;
sp = sp->next;
}
}
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
/*
* Resolve all labels.
*/
for (i = 0; i < stp->num_labels; i++) {
- Uint this_patch;
- Uint next_patch;
+ Sint this_patch;
+ Sint next_patch;
Uint value = stp->labels[i].value;
- if (value == 0 && stp->labels[i].patches != 0) {
+ if (value == 0 && stp->labels[i].patches >= 0) {
LoadError1(stp, "label %d not resolved", i);
}
ASSERT(value < stp->ci);
this_patch = stp->labels[i].patches;
- while (this_patch != 0) {
+ while (this_patch >= 0) {
ASSERT(this_patch < stp->ci);
- next_patch = code[this_patch];
+ next_patch = codev[this_patch];
ASSERT(next_patch < stp->ci);
- code[this_patch] = (BeamInstr) (code + value);
+ codev[this_patch] = (BeamInstr) (codev + value);
this_patch = next_patch;
}
}
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
/*
* Save the updated code pointer and code size.
*/
- stp->code = code;
+ stp->hdr = code_hdr;
+ stp->codev = codev;
stp->loaded_size = size;
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
return 1;
load_error:
@@ -4599,7 +4669,8 @@ freeze_code(LoaderState* stp)
* Make sure that the caller frees the newly reallocated block, and
* not the old one (in case it has moved).
*/
- stp->code = code;
+ stp->hdr = code_hdr;
+ stp->codev = codev;
return 0;
}
@@ -4610,7 +4681,7 @@ final_touch(LoaderState* stp)
int on_load = stp->on_load;
unsigned catches;
Uint index;
- BeamInstr* code = stp->code;
+ BeamInstr* codev = stp->codev;
Module* modp;
/*
@@ -4620,10 +4691,10 @@ final_touch(LoaderState* stp)
index = stp->catches;
catches = BEAM_CATCHES_NIL;
while (index != 0) {
- BeamInstr next = code[index];
- code[index] = BeamOpCode(op_catch_yf);
- catches = beam_catches_cons((BeamInstr *)code[index+2], catches);
- code[index+2] = make_catch(catches);
+ BeamInstr next = codev[index];
+ codev[index] = BeamOpCode(op_catch_yf);
+ catches = beam_catches_cons((BeamInstr *)codev[index+2], catches);
+ codev[index+2] = make_catch(catches);
index = next;
}
modp = erts_put_module(stp->module);
@@ -4674,8 +4745,8 @@ final_touch(LoaderState* stp)
current = stp->import[i].patches;
while (current != 0) {
ASSERT(current < stp->ci);
- next = stp->code[current];
- stp->code[current] = import;
+ next = stp->codev[current];
+ stp->codev[current] = import;
current = next;
}
}
@@ -4688,7 +4759,7 @@ final_touch(LoaderState* stp)
for (i = 0; i < stp->num_lambdas; i++) {
unsigned entry_label = stp->lambdas[i].label;
ErlFunEntry* fe = stp->lambdas[i].fe;
- BeamInstr* code_ptr = (BeamInstr *) (stp->code + stp->labels[entry_label].value);
+ BeamInstr* code_ptr = stp->codev + stp->labels[entry_label].value;
if (fe->address[0] != 0) {
/*
@@ -4801,7 +4872,8 @@ transform_engine(LoaderState* st)
if (var[i].type != instr->a[ap].type)
goto restart;
switch (var[i].type) {
- case TAG_r: case TAG_n: break;
+ case TAG_n:
+ break;
default:
if (var[i].val != instr->a[ap].val)
goto restart;
@@ -5311,7 +5383,7 @@ new_label(LoaderState* stp)
(void *) stp->labels,
stp->num_labels * sizeof(Label));
stp->labels[num].value = 0;
- stp->labels[num].patches = 0;
+ stp->labels[num].patches = -1;
return num;
}
@@ -5371,7 +5443,7 @@ erts_module_info_0(Process* p, Eterm module)
{
Module* modp;
ErtsCodeIndex code_ix = erts_active_code_ix();
- BeamInstr* code;
+ BeamCodeHeader* code_hdr;
Eterm *hp;
Eterm list = NIL;
Eterm tup;
@@ -5385,13 +5457,13 @@ erts_module_info_0(Process* p, Eterm module)
return THE_NON_VALUE;
}
- code = modp->curr.code;
- if (code == NULL) {
+ code_hdr = modp->curr.code_hdr;
+ if (code_hdr == NULL) {
return THE_NON_VALUE;
}
#define BUILD_INFO(What) \
- tup = get_module_info(p, code_ix, code, module, What); \
+ tup = get_module_info(p, code_ix, code_hdr, module, What); \
hp = HAlloc(p, 5); \
tup = TUPLE2(hp, What, tup); \
hp += 3; \
@@ -5414,7 +5486,7 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
{
Module* modp;
ErtsCodeIndex code_ix = erts_active_code_ix();
- BeamInstr* code;
+ BeamCodeHeader* code_hdr;
if (is_not_atom(module)) {
return THE_NON_VALUE;
@@ -5425,34 +5497,34 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
return THE_NON_VALUE;
}
- code = modp->curr.code;
- if (code == NULL) {
+ code_hdr = modp->curr.code_hdr;
+ if (code_hdr == NULL) {
return THE_NON_VALUE;
}
- return get_module_info(p, code_ix, code, module, what);
+ return get_module_info(p, code_ix, code_hdr, module, what);
}
static Eterm
-get_module_info(Process* p, ErtsCodeIndex code_ix, BeamInstr* code,
+get_module_info(Process* p, ErtsCodeIndex code_ix, BeamCodeHeader* code_hdr,
Eterm module, Eterm what)
{
if (what == am_module) {
return module;
} else if (what == am_md5) {
- return md5_of_module(p, code);
+ return md5_of_module(p, code_hdr);
} else if (what == am_exports) {
return exported_from_module(p, code_ix, module);
} else if (what == am_functions) {
- return functions_in_module(p, code);
+ return functions_in_module(p, code_hdr);
} else if (what == am_attributes) {
- return attributes_for_module(p, code);
+ return attributes_for_module(p, code_hdr);
} else if (what == am_compile) {
- return compilation_info_for_module(p, code);
+ return compilation_info_for_module(p, code_hdr);
} else if (what == am_native_addresses) {
- return native_addresses(p, code);
+ return native_addresses(p, code_hdr);
} else if (what == am_native) {
- return has_native(code);
+ return has_native(code_hdr);
}
return THE_NON_VALUE;
}
@@ -5464,7 +5536,7 @@ get_module_info(Process* p, ErtsCodeIndex code_ix, BeamInstr* code,
Eterm
functions_in_module(Process* p, /* Process whose heap to use. */
- BeamInstr* code)
+ BeamCodeHeader* code_hdr)
{
int i;
Uint num_functions;
@@ -5473,12 +5545,12 @@ functions_in_module(Process* p, /* Process whose heap to use. */
Eterm* hp_end;
Eterm result = NIL;
- num_functions = code[MI_NUM_FUNCTIONS];
+ num_functions = code_hdr->num_functions;
need = 5*num_functions;
hp = HAlloc(p, need);
hp_end = hp + need;
for (i = num_functions-1; i >= 0 ; i--) {
- BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
+ BeamInstr* func_info = code_hdr->functions[i];
Eterm name = (Eterm) func_info[3];
int arity = (int) func_info[4];
Eterm tuple;
@@ -5504,11 +5576,11 @@ functions_in_module(Process* p, /* Process whose heap to use. */
*/
static Eterm
-has_native(BeamInstr *code)
+has_native(BeamCodeHeader *code_hdr)
{
Eterm result = am_false;
#ifdef HIPE
- if (erts_is_module_native(code)) {
+ if (erts_is_module_native(code_hdr)) {
result = am_true;
}
#endif
@@ -5516,15 +5588,15 @@ has_native(BeamInstr *code)
}
int
-erts_is_module_native(BeamInstr* code)
+erts_is_module_native(BeamCodeHeader* code_hdr)
{
Uint i, num_functions;
/* Check NativeAdress of first real function in module */
- if (code != NULL) {
- num_functions = code[MI_NUM_FUNCTIONS];
+ if (code_hdr != NULL) {
+ num_functions = code_hdr->num_functions;
for (i=0; i<num_functions; i++) {
- BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
+ BeamInstr* func_info = (BeamInstr *) code_hdr->functions[i];
Eterm name = (Eterm) func_info[3];
if (is_atom(name)) {
return func_info[1] != 0;
@@ -5541,7 +5613,7 @@ erts_is_module_native(BeamInstr* code)
*/
static Eterm
-native_addresses(Process* p, BeamInstr* code)
+native_addresses(Process* p, BeamCodeHeader* code_hdr)
{
int i;
Eterm* hp;
@@ -5550,12 +5622,12 @@ native_addresses(Process* p, BeamInstr* code)
Eterm* hp_end;
Eterm result = NIL;
- num_functions = code[MI_NUM_FUNCTIONS];
+ num_functions = code_hdr->num_functions;
need = (6+BIG_UINT_HEAP_SIZE)*num_functions;
hp = HAlloc(p, need);
hp_end = hp + need;
for (i = num_functions-1; i >= 0 ; i--) {
- BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
+ BeamInstr* func_info = code_hdr->functions[i];
Eterm name = (Eterm) func_info[3];
int arity = (int) func_info[4];
Eterm tuple;
@@ -5621,15 +5693,15 @@ exported_from_module(Process* p, /* Process whose heap to use. */
Eterm
attributes_for_module(Process* p, /* Process whose heap to use. */
- BeamInstr* code)
+ BeamCodeHeader* code_hdr)
{
byte* ext;
Eterm result = NIL;
- ext = (byte *) code[MI_ATTR_PTR];
+ ext = code_hdr->attr_ptr;
if (ext != NULL) {
ErtsHeapFactory factory;
- erts_factory_proc_prealloc_init(&factory, p, code[MI_ATTR_SIZE_ON_HEAP]);
+ erts_factory_proc_prealloc_init(&factory, p, code_hdr->attr_size_on_heap);
result = erts_decode_ext(&factory, &ext);
if (is_value(result)) {
erts_factory_close(&factory);
@@ -5644,15 +5716,15 @@ attributes_for_module(Process* p, /* Process whose heap to use. */
Eterm
compilation_info_for_module(Process* p, /* Process whose heap to use. */
- BeamInstr* code)
+ BeamCodeHeader* code_hdr)
{
byte* ext;
Eterm result = NIL;
- ext = (byte *) code[MI_COMPILE_PTR];
+ ext = code_hdr->compile_ptr;
if (ext != NULL) {
ErtsHeapFactory factory;
- erts_factory_proc_prealloc_init(&factory, p, code[MI_COMPILE_SIZE_ON_HEAP]);
+ erts_factory_proc_prealloc_init(&factory, p, code_hdr->compile_size_on_heap);
result = erts_decode_ext(&factory, &ext);
if (is_value(result)) {
erts_factory_close(&factory);
@@ -5667,9 +5739,9 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */
Eterm
md5_of_module(Process* p, /* Process whose heap to use. */
- BeamInstr* code)
+ BeamCodeHeader* code_hdr)
{
- return new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE);
+ return new_binary(p, code_hdr->md5_ptr, MD5_SIZE);
}
/*
@@ -5868,7 +5940,7 @@ make_stub(BeamInstr* fp, Eterm mod, Eterm func, Uint arity, Uint native, BeamIns
fp[4] = arity;
#ifdef HIPE
if (native) {
- fp[5] = BeamOpCode(op_move_return_nr);
+ fp[5] = BeamOpCode(op_move_return_n);
hipe_mfa_save_orig_beam_op(mod, func, arity, fp+5);
}
#endif
@@ -5880,7 +5952,7 @@ static byte*
stub_copy_info(LoaderState* stp,
int chunk, /* Chunk: ATTR_CHUNK or COMPILE_CHUNK */
byte* info, /* Where to store info. */
- BeamInstr* ptr_word, /* Where to store pointer into info. */
+ byte** ptr_word, /* Where to store pointer into info. */
BeamInstr* size_word, /* Where to store size into info. */
BeamInstr* size_on_heap_word) /* Where to store size on heap. */
{
@@ -5888,7 +5960,7 @@ stub_copy_info(LoaderState* stp,
Uint size = stp->chunks[chunk].size;
if (size != 0) {
memcpy(info, stp->chunks[chunk].start, size);
- *ptr_word = (BeamInstr) info;
+ *ptr_word = info;
decoded_size = erts_decode_ext_size(info, size);
if (decoded_size < 0) {
return 0;
@@ -6143,15 +6215,14 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
BeamInstr Patchlist;
Eterm MD5Bin;
Eterm* tp;
- BeamInstr* code = NULL;
- BeamInstr* ptrs;
+ BeamCodeHeader* code_hdr;
+ BeamInstr* code_base;
BeamInstr* fp;
byte* info;
- Uint ci;
- int n;
+ Sint n;
int code_size;
int rval;
- int i;
+ Sint i;
byte* temp_alloc = NULL;
byte* bytes;
Uint size;
@@ -6225,40 +6296,40 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Allocate memory for the stub module.
*/
- code_size = ((WORDS_PER_FUNCTION+1)*n + MI_FUNCTIONS + 2) * sizeof(BeamInstr);
- code_size += stp->chunks[ATTR_CHUNK].size;
- code_size += stp->chunks[COMPILE_CHUNK].size;
- code_size += MD5_SIZE;
- code = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size);
- if (!code) {
+ code_size = (offsetof(BeamCodeHeader,functions)
+ + ((n+1) * sizeof(BeamInstr*))
+ + (WORDS_PER_FUNCTION*n + 1) * sizeof(BeamInstr)
+ + stp->chunks[ATTR_CHUNK].size
+ + stp->chunks[COMPILE_CHUNK].size
+ + MD5_SIZE);
+ code_hdr = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size);
+ if (!code_hdr) {
goto error;
}
/*
- * Initialize code area.
+ * Initialize code header.
*/
- code[MI_NUM_FUNCTIONS] = n;
- code[MI_ATTR_PTR] = 0;
- code[MI_ATTR_SIZE] = 0;
- code[MI_ATTR_SIZE_ON_HEAP] = 0;
- code[MI_COMPILE_PTR] = 0;
- code[MI_COMPILE_SIZE] = 0;
- code[MI_COMPILE_SIZE_ON_HEAP] = 0;
- code[MI_LITERALS_START] = 0;
- code[MI_LITERALS_END] = 0;
- code[MI_LITERALS_OFF_HEAP] = 0;
- code[MI_ON_LOAD_FUNCTION_PTR] = 0;
- code[MI_LINE_TABLE] = 0;
- code[MI_MD5_PTR] = 0;
- ci = MI_FUNCTIONS + n + 1;
+ code_hdr->num_functions = n;
+ code_hdr->attr_ptr = NULL;
+ code_hdr->attr_size = 0;
+ code_hdr->attr_size_on_heap = 0;
+ code_hdr->compile_ptr = NULL;
+ code_hdr->compile_size = 0;
+ code_hdr->compile_size_on_heap = 0;
+ code_hdr->literals_start = NULL;
+ code_hdr->literals_end = NULL;
+ code_hdr->literals_off_heap = 0;
+ code_hdr->on_load_function_ptr = NULL;
+ code_hdr->line_table = NULL;
+ code_hdr->md5_ptr = NULL;
/*
* Make stubs for all functions.
*/
- ptrs = code + MI_FUNCTIONS;
- fp = code + ci;
+ fp = code_base = (BeamInstr*) &code_hdr->functions[n+1];
for (i = 0; i < n; i++) {
Eterm* listp;
Eterm tuple;
@@ -6301,11 +6372,11 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Set the pointer and make the stub. Put a return instruction
* as the body until we know what kind of trap we should put there.
*/
- ptrs[i] = (BeamInstr) fp;
+ code_hdr->functions[i] = fp;
#ifdef HIPE
op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */
#else
- op = (Eterm) BeamOpCode(op_move_return_nr);
+ op = (Eterm) BeamOpCode(op_move_return_n);
#endif
fp = make_stub(fp, Mod, func, arity, (Uint)native_address, op);
}
@@ -6314,7 +6385,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Insert the last pointer and the int_code_end instruction.
*/
- ptrs[i] = (BeamInstr) fp;
+ code_hdr->functions[i] = fp;
*fp++ = (BeamInstr) BeamOp(op_int_code_end);
/*
@@ -6323,16 +6394,16 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
info = (byte *) fp;
info = stub_copy_info(stp, ATTR_CHUNK, info,
- code+MI_ATTR_PTR,
- code+MI_ATTR_SIZE,
- code+MI_ATTR_SIZE_ON_HEAP);
+ &code_hdr->attr_ptr,
+ &code_hdr->attr_size,
+ &code_hdr->attr_size_on_heap);
if (info == NULL) {
goto error;
}
info = stub_copy_info(stp, COMPILE_CHUNK, info,
- code+MI_COMPILE_PTR,
- code+MI_COMPILE_SIZE,
- code+MI_COMPILE_SIZE_ON_HEAP);
+ &code_hdr->compile_ptr,
+ &code_hdr->compile_size,
+ &code_hdr->compile_size_on_heap);
if (info == NULL) {
goto error;
}
@@ -6341,7 +6412,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
byte *md5 = NULL;
if ((md5 = erts_get_aligned_binary_bytes(MD5Bin, &tmp)) != NULL) {
sys_memcpy(info, md5, MD5_SIZE);
- code[MI_MD5_PTR] = (BeamInstr) info;
+ code_hdr->md5_ptr = info;
}
erts_free_aligned_binary_bytes(tmp);
}
@@ -6350,7 +6421,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Insert the module in the module table.
*/
- rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size);
+ rval = insert_new_code(p, 0, p->group_leader, Mod, code_hdr, code_size);
if (rval != NIL) {
goto error;
}
@@ -6359,7 +6430,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Export all stub functions and insert the correct type of HiPE trap.
*/
- fp = code + ci;
+ fp = code_base;
for (i = 0; i < n; i++) {
stub_final_touch(stp, fp);
fp += WORDS_PER_FUNCTION;
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index d5af634fad..22ab71c868 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -24,7 +24,6 @@
#include "beam_opcodes.h"
#include "erl_process.h"
-int erts_is_module_native(BeamInstr* code);
Eterm beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks,
Eterm module);
@@ -52,6 +51,7 @@ extern BeamInstr* em_call_error_handler;
extern BeamInstr* em_apply_bif;
extern BeamInstr* em_call_nif;
+
/*
* The following variables keep a sorted list of address ranges for
* each module. It allows us to quickly find a function given an
@@ -60,72 +60,81 @@ extern BeamInstr* em_call_nif;
/* Total code size in bytes */
extern Uint erts_total_code_size;
-/*
- * Index into start of code chunks which contains additional information
- * about the loaded module.
- *
- * First number of functions.
- */
-#define MI_NUM_FUNCTIONS 0
+typedef struct BeamCodeLineTab_ BeamCodeLineTab;
/*
- * The attributes retrieved by Mod:module_info(attributes).
- */
-
-#define MI_ATTR_PTR 1
-#define MI_ATTR_SIZE 2
-#define MI_ATTR_SIZE_ON_HEAP 3
-
-/*
- * The compilation information retrieved by Mod:module_info(compile).
- */
-
-#define MI_COMPILE_PTR 4
-#define MI_COMPILE_SIZE 5
-#define MI_COMPILE_SIZE_ON_HEAP 6
-
-/*
- * Literal area (constant pool).
- */
-#define MI_LITERALS_START 7
-#define MI_LITERALS_END 8
-#define MI_LITERALS_OFF_HEAP 9
-
-/*
- * Pointer to the on_load function (or NULL if none).
- */
-#define MI_ON_LOAD_FUNCTION_PTR 10
-
-/*
- * Pointer to the line table (or NULL if none).
- */
-#define MI_LINE_TABLE 11
-
-/*
- * Pointer to the module MD5 sum (16 bytes)
- */
-#define MI_MD5_PTR 12
-
-/*
- * Start of function pointer table. This table contains pointers to
- * all functions in the module plus an additional pointer just beyond
- * the end of the last function.
- *
- * The actual loaded code (for the first function) start just beyond
- * this table.
+ * Header of code chunks which contains additional information
+ * about the loaded module.
*/
-
-#define MI_FUNCTIONS 13
+typedef struct beam_code_header {
+ /*
+ * Number of functions.
+ */
+ UWord num_functions;
+
+ /*
+ * The attributes retrieved by Mod:module_info(attributes).
+ */
+ byte* attr_ptr;
+ UWord attr_size;
+ UWord attr_size_on_heap;
+
+ /*
+ * The compilation information retrieved by Mod:module_info(compile).
+ */
+ byte* compile_ptr;
+ UWord compile_size;
+ UWord compile_size_on_heap;
+
+ /*
+ * Literal area (constant pool).
+ */
+ Eterm* literals_start;
+ Eterm* literals_end;
+ struct erl_off_heap_header* literals_off_heap;
+
+ /*
+ * Pointer to the on_load function (or NULL if none).
+ */
+ BeamInstr* on_load_function_ptr;
+
+ /*
+ * Pointer to the line table (or NULL if none).
+ */
+ BeamCodeLineTab* line_table;
+
+ /*
+ * Pointer to the module MD5 sum (16 bytes)
+ */
+ byte* md5_ptr;
+
+ /*
+ * Start of function pointer table. This table contains pointers to
+ * all functions in the module plus an additional pointer just beyond
+ * the end of the last function.
+ *
+ * The actual loaded code (for the first function) start just beyond
+ * this table.
+ */
+ BeamInstr* functions[1];
+
+}BeamCodeHeader;
+
+int erts_is_module_native(BeamCodeHeader* code);
/*
* Layout of the line table.
*/
-
-#define MI_LINE_FNAME_PTR 0
-#define MI_LINE_LOC_TAB 1
-#define MI_LINE_LOC_SIZE 2
-#define MI_LINE_FUNC_TAB 3
+struct BeamCodeLineTab_ {
+ Eterm* fname_ptr;
+ int loc_size;
+ union {
+ Uint16* p2;
+ Uint32* p4;
+ }loc_tab;
+ const BeamInstr** func_tab[1];
+};
#define LINE_INVALID_LOCATION (0)
diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c
index 19079ba150..5a2b66727a 100644
--- a/erts/emulator/beam/beam_ranges.c
+++ b/erts/emulator/beam/beam_ranges.c
@@ -37,8 +37,8 @@ typedef struct {
#define RANGE_END(R) ((BeamInstr*)erts_smp_atomic_read_nob(&(R)->end))
static Range* find_range(BeamInstr* pc);
-static void lookup_loc(FunctionInfo* fi, BeamInstr* pc,
- BeamInstr* modp, int idx);
+static void lookup_loc(FunctionInfo* fi, const BeamInstr* pc,
+ BeamCodeHeader*, int idx);
/*
* The following variables keep a sorted list of address ranges for
@@ -241,6 +241,7 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
BeamInstr** high;
BeamInstr** mid;
Range* rp;
+ BeamCodeHeader* hdr;
fi->current = NULL;
fi->needed = 5;
@@ -249,9 +250,10 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
if (rp == 0) {
return;
}
+ hdr = (BeamCodeHeader*) rp->start;
- low = (BeamInstr **) (rp->start + MI_FUNCTIONS);
- high = low + rp->start[MI_NUM_FUNCTIONS];
+ low = hdr->functions;
+ high = low + hdr->num_functions;
while (low < high) {
mid = low + (high-low) / 2;
if (pc < mid[0]) {
@@ -259,10 +261,9 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
} else if (pc < mid[1]) {
fi->current = mid[0]+2;
if (full_info) {
- BeamInstr** fp = (BeamInstr **) (rp->start +
- MI_FUNCTIONS);
+ BeamInstr** fp = hdr->functions;
int idx = mid - fp;
- lookup_loc(fi, pc, rp->start, idx);
+ lookup_loc(fi, pc, hdr, idx);
}
return;
} else {
@@ -295,39 +296,34 @@ find_range(BeamInstr* pc)
}
static void
-lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamInstr* modp, int idx)
+lookup_loc(FunctionInfo* fi, const BeamInstr* pc,
+ BeamCodeHeader* code_hdr, int idx)
{
- Eterm* line = (Eterm *) modp[MI_LINE_TABLE];
- Eterm* low;
- Eterm* high;
- Eterm* mid;
- Eterm pc;
+ BeamCodeLineTab* lt = code_hdr->line_table;
+ const BeamInstr** low;
+ const BeamInstr** high;
+ const BeamInstr** mid;
- if (line == 0) {
+ if (lt == NULL) {
return;
}
- pc = (Eterm) (BeamInstr) orig_pc;
- fi->fname_ptr = (Eterm *) (BeamInstr) line[MI_LINE_FNAME_PTR];
- low = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx];
- high = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx+1];
+ fi->fname_ptr = lt->fname_ptr;
+ low = lt->func_tab[idx];
+ high = lt->func_tab[idx+1];
while (high > low) {
mid = low + (high-low) / 2;
if (pc < mid[0]) {
high = mid;
} else if (pc < mid[1]) {
int file;
- int index = mid - (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB];
+ int index = mid - lt->func_tab[0];
- if (line[MI_LINE_LOC_SIZE] == 2) {
- Uint16* loc_table =
- (Uint16 *) (BeamInstr) line[MI_LINE_LOC_TAB];
- fi->loc = loc_table[index];
+ if (lt->loc_size == 2) {
+ fi->loc = lt->loc_tab.p2[index];
} else {
- Uint32* loc_table =
- (Uint32 *) (BeamInstr) line[MI_LINE_LOC_TAB];
- ASSERT(line[MI_LINE_LOC_SIZE] == 4);
- fi->loc = loc_table[index];
+ ASSERT(lt->loc_size == 4);
+ fi->loc = lt->loc_tab.p4[index];
}
if (fi->loc == LINE_INVALID_LOCATION) {
return;
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index a8cc19ee1f..2654785ffc 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -44,6 +44,7 @@
#include "erl_ptab.h"
#include "erl_bits.h"
#include "erl_bif_unique.h"
+#include "erl_msacc.h"
Export *erts_await_result;
static Export* flush_monitor_messages_trap = NULL;
@@ -54,6 +55,9 @@ Export* erts_format_cpu_topology_trap = NULL;
static Export dsend_continue_trap_export;
Export *erts_convert_time_unit_trap = NULL;
+static Export *await_msacc_mod_trap = NULL;
+static erts_smp_atomic32_t msacc;
+
static Export *await_sched_wall_time_mod_trap;
static erts_smp_atomic32_t sched_wall_time;
@@ -72,7 +76,7 @@ BIF_RETTYPE spawn_3(BIF_ALIST_3)
ErlSpawnOpts so;
Eterm pid;
- so.flags = 0;
+ so.flags = erts_default_spo_flags;
pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so);
if (is_non_value(pid)) {
BIF_ERROR(BIF_P, so.error_code);
@@ -589,7 +593,7 @@ erts_queue_monitor_message(Process *p,
Eterm reason_copy, ref_copy, item_copy;
Uint reason_size, ref_size, item_size, heap_size;
ErlOffHeap *ohp;
- ErlHeapFragment *bp;
+ ErtsMessage *msgp;
reason_size = IS_CONST(reason) ? 0 : size_object(reason);
item_size = IS_CONST(item) ? 0 : size_object(item);
@@ -597,11 +601,8 @@ erts_queue_monitor_message(Process *p,
heap_size = 6+reason_size+ref_size+item_size;
- hp = erts_alloc_message_heap(heap_size,
- &bp,
- &ohp,
- p,
- p_locksp);
+ msgp = erts_alloc_message_heap(p, p_locksp, heap_size,
+ &hp, &ohp);
reason_copy = (IS_CONST(reason)
? reason
@@ -612,7 +613,7 @@ erts_queue_monitor_message(Process *p,
ref_copy = copy_struct(ref, ref_size, &hp, ohp);
tup = TUPLE5(hp, am_DOWN, ref_copy, type, item_copy, reason_copy);
- erts_queue_message(p, p_locksp, bp, tup, NIL);
+ erts_queue_message(p, p_locksp, msgp, tup, NIL);
}
static BIF_RETTYPE
@@ -841,7 +842,7 @@ BIF_RETTYPE spawn_link_3(BIF_ALIST_3)
ErlSpawnOpts so;
Eterm pid;
- so.flags = SPO_LINK;
+ so.flags = erts_default_spo_flags|SPO_LINK;
pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so);
if (is_non_value(pid)) {
BIF_ERROR(BIF_P, so.error_code);
@@ -878,7 +879,7 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1)
/*
* Store default values for options.
*/
- so.flags = SPO_USE_ARGS;
+ so.flags = erts_default_spo_flags|SPO_USE_ARGS;
so.min_heap_size = H_MIN_SIZE;
so.min_vheap_size = BIN_VH_MIN_SIZE;
so.priority = PRIORITY_NORMAL;
@@ -913,6 +914,22 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1)
so.priority = PRIORITY_LOW;
else
goto error;
+ } else if (arg == am_message_queue_data) {
+ switch (val) {
+ case am_mixed:
+ so.flags &= ~(SPO_OFF_HEAP_MSGQ|SPO_ON_HEAP_MSGQ);
+ break;
+ case am_on_heap:
+ so.flags &= ~SPO_OFF_HEAP_MSGQ;
+ so.flags |= SPO_ON_HEAP_MSGQ;
+ break;
+ case am_off_heap:
+ so.flags &= ~SPO_ON_HEAP_MSGQ;
+ so.flags |= SPO_OFF_HEAP_MSGQ;
+ break;
+ default:
+ goto error;
+ }
} else if (arg == am_min_heap_size && is_small(val)) {
Sint min_heap_size = signed_val(val);
if (min_heap_size < 0) {
@@ -1691,6 +1708,12 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
}
BIF_RET(old_value);
}
+ else if (BIF_ARG_1 == am_message_queue_data) {
+ old_value = erts_change_message_queue_management(BIF_P, BIF_ARG_2);
+ if (is_non_value(old_value))
+ goto error;
+ BIF_RET(old_value);
+ }
else if (BIF_ARG_1 == am_sensitive) {
Uint is_sensitive;
if (BIF_ARG_2 == am_true) {
@@ -1931,7 +1954,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx)
} else if (is_atom(to)) {
Eterm id = erts_whereis_name_to_id(p, to);
- rp = erts_proc_lookup(id);
+ rp = erts_proc_lookup_raw(id);
if (rp) {
if (IS_TRACED(p))
trace_send(p, to, msg);
@@ -2023,11 +2046,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx)
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
save_calls(p, &exp_send);
- if (SEQ_TRACE_TOKEN(p) != NIL
-#ifdef USE_VM_PROBES
- && SEQ_TRACE_TOKEN(p) != am_have_dt_utag
-#endif
- ) {
+ if (have_seqtrace(SEQ_TRACE_TOKEN(p))) {
seq_trace_update_send(p);
seq_trace_output(SEQ_TRACE_TOKEN(p), msg,
SEQ_TRACE_SEND, portid, p);
@@ -2128,7 +2147,11 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
int connect = !0;
Eterm l = opts;
Sint result;
+
DeclareTypedTmpHeap(ErtsSendContext, ctx, BIF_P);
+
+ ERTS_MSACC_PUSH_STATE_M_X();
+
UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P);
ctx->suspend = !0;
@@ -2157,7 +2180,10 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
ref = NIL;
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_SEND);
result = do_send(p, to, msg, &ref, ctx);
+ ERTS_MSACC_POP_STATE_M_X();
+
if (result > 0) {
ERTS_VBUMP_REDS(p, result);
if (ERTS_IS_PROC_OUT_OF_REDS(p))
@@ -2273,8 +2299,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
Eterm ref;
Sint result;
DeclareTypedTmpHeap(ErtsSendContext, ctx, p);
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_SEND);
UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p);
-
#ifdef DEBUG
ref = NIL;
#endif
@@ -2285,7 +2311,9 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT;
result = do_send(p, to, msg, &ref, ctx);
-
+
+ ERTS_MSACC_POP_STATE_M_X();
+
if (result > 0) {
ERTS_VBUMP_REDS(p, result);
if (ERTS_IS_PROC_OUT_OF_REDS(p))
@@ -2809,7 +2837,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1)
{
Eterm res;
char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS);
- int i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS);
+ Sint i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS);
if (i < 0) {
erts_free(ERTS_ALC_T_TMP, (void *) buf);
@@ -2829,7 +2857,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1)
BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1)
{
- int i;
+ Sint i;
char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS);
if ((i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS)) < 0) {
@@ -2889,175 +2917,20 @@ BIF_RETTYPE integer_to_list_1(BIF_ALIST_1)
/**********************************************************************/
-/* convert a list of ascii ascii integer value to an integer */
-
-
-#define LTI_BAD_STRUCTURE 0
-#define LTI_NO_INTEGER 1
-#define LTI_SOME_INTEGER 2
-#define LTI_ALL_INTEGER 3
-
-static int do_list_to_integer(Process *p, Eterm orig_list,
- Eterm *integer, Eterm *rest)
-{
- Sint i = 0;
- Uint ui = 0;
- int skip = 0;
- int neg = 0;
- Sint n = 0;
- int m;
- int lg2;
- Eterm res;
- Eterm* hp;
- Eterm *hp_end;
- Eterm lst = orig_list;
- Eterm tail = lst;
- int error_res = LTI_BAD_STRUCTURE;
-
- if (is_nil(lst)) {
- error_res = LTI_NO_INTEGER;
- error:
- *rest = tail;
- *integer = make_small(0);
- return error_res;
- }
- if (is_not_list(lst))
- goto error;
-
- /* if first char is a '-' then it is a negative integer */
- if (CAR(list_val(lst)) == make_small('-')) {
- neg = 1;
- skip = 1;
- lst = CDR(list_val(lst));
- if (is_not_list(lst)) {
- tail = lst;
- error_res = LTI_NO_INTEGER;
- goto error;
- }
- } else if (CAR(list_val(lst)) == make_small('+')) {
- /* ignore plus */
- skip = 1;
- lst = CDR(list_val(lst));
- if (is_not_list(lst)) {
- tail = lst;
- error_res = LTI_NO_INTEGER;
- goto error;
- }
- }
-
- /* Calculate size and do type check */
-
- while(1) {
- if (is_not_small(CAR(list_val(lst)))) {
- break;
- }
- if (unsigned_val(CAR(list_val(lst))) < '0' ||
- unsigned_val(CAR(list_val(lst))) > '9') {
- break;
- }
- ui = ui * 10;
- ui = ui + unsigned_val(CAR(list_val(lst))) - '0';
- n++;
- lst = CDR(list_val(lst));
- if (is_nil(lst)) {
- break;
- }
- if (is_not_list(lst)) {
- break;
- }
- }
-
- tail = lst;
- if (!n) {
- error_res = LTI_NO_INTEGER;
- goto error;
- }
-
-
- /* If n <= 8 then we know it's a small int
- ** since 2^27 = 134217728. If n > 8 then we must
- ** construct a bignum and let that routine do the checking
- */
-
- if (n <= SMALL_DIGITS) { /* It must be small */
- if (neg) i = -(Sint)ui;
- else i = (Sint)ui;
- res = make_small(i);
- } else {
- /* Convert from log10 to log2 by multiplying with 1/log10(2)=3.3219
- which we round up to (3 + 1/3) */
- lg2 = (n+1)*3 + (n+1)/3 + 1;
- m = (lg2+D_EXP-1)/D_EXP; /* number of digits */
- m = BIG_NEED_SIZE(m); /* number of words + thing */
-
- hp = HAlloc(p, m);
- hp_end = hp + m;
-
- lst = orig_list;
- if (skip)
- lst = CDR(list_val(lst));
-
- /* load first digits (at least one digit) */
- if ((i = (n % D_DECIMAL_EXP)) == 0)
- i = D_DECIMAL_EXP;
- n -= i;
- m = 0;
- while(i--) {
- m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0');
- lst = CDR(list_val(lst));
- }
- res = small_to_big(m, hp); /* load first digits */
-
- while(n) {
- i = D_DECIMAL_EXP;
- n -= D_DECIMAL_EXP;
- m = 0;
- while(i--) {
- m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0');
- lst = CDR(list_val(lst));
- }
- if (is_small(res))
- res = small_to_big(signed_val(res), hp);
- res = big_times_small(res, D_DECIMAL_BASE, hp);
- if (is_small(res))
- res = small_to_big(signed_val(res), hp);
- res = big_plus_small(res, m, hp);
- }
-
- if (neg) {
- if (is_small(res))
- res = make_small(-signed_val(res));
- else {
- Uint *big = big_val(res); /* point to thing */
- *big = bignum_header_neg(*big);
- }
- }
-
- if (is_not_small(res)) {
- res = big_plus_small(res, 0, hp); /* includes conversion to small */
+/*
+ * Converts a list of ascii base10 digits to an integer fully or partially.
+ * Returns result and the remaining tail.
+ * On error returns: {error,not_a_list}, or {error, no_integer}
+ */
- if (is_not_small(res)) {
- hp += (big_arity(res)+1);
- }
- }
- HRelease(p,hp_end,hp);
- }
- *integer = res;
- *rest = tail;
- if (tail != NIL) {
- return LTI_SOME_INTEGER;
- }
- return LTI_ALL_INTEGER;
-}
BIF_RETTYPE string_to_integer_1(BIF_ALIST_1)
{
Eterm res;
Eterm tail;
Eterm *hp;
/* must be a list */
- switch (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&tail)) {
- /* HAlloc after do_list_to_integer as it
- might HAlloc itself (bignum) */
+ switch (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, &res, &tail)) {
+ /* HAlloc after erts_list_to_integer as it might HAlloc itself (bignum) */
case LTI_BAD_STRUCTURE:
hp = HAlloc(BIF_P,3);
BIF_RET(TUPLE2(hp, am_error, am_not_a_list));
@@ -3072,13 +2945,14 @@ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1)
BIF_RETTYPE list_to_integer_1(BIF_ALIST_1)
{
- /* Using do_list_to_integer is about twice as fast as using
+ /* Using erts_list_to_integer is about twice as fast as using
erts_chars_to_integer because we do not have to copy the
entire list */
Eterm res;
Eterm dummy;
/* must be a list */
- if (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&dummy) != LTI_ALL_INTEGER) {
+ if (erts_list_to_integer(BIF_P, BIF_ARG_1, 10,
+ &res, &dummy) != LTI_ALL_INTEGER) {
BIF_ERROR(BIF_P,BADARG);
}
BIF_RET(res);
@@ -3086,14 +2960,12 @@ BIF_RETTYPE list_to_integer_1(BIF_ALIST_1)
BIF_RETTYPE list_to_integer_2(BIF_ALIST_2)
{
-
/* Bif implementation is about 50% faster than pure erlang,
and since we have erts_chars_to_integer now it is simpler
as well. This could be optmized further if we did not have to
copy the list to buf. */
- int i;
- Eterm res;
- char *buf = NULL;
+ Sint i;
+ Eterm res, dummy;
int base;
i = erts_list_length(BIF_ARG_1);
@@ -3101,31 +2973,16 @@ BIF_RETTYPE list_to_integer_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
base = signed_val(BIF_ARG_2);
-
+
if (base < 2 || base > 36)
BIF_ERROR(BIF_P, BADARG);
- /* Take fast path if base it 10 */
- if (base == 10)
- return list_to_integer_1(BIF_P,&BIF_ARG_1);
-
- buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1);
-
- if (intlist_to_buf(BIF_ARG_1, buf, i) < 0)
- goto list_to_integer_1_error;
- buf[i] = '\0'; /* null terminal */
-
- if ((res = erts_chars_to_integer(BIF_P,buf,i,base)) == THE_NON_VALUE)
- goto list_to_integer_1_error;
-
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
+ if (erts_list_to_integer(BIF_P, BIF_ARG_1, base,
+ &res, &dummy) != LTI_ALL_INTEGER) {
+ BIF_ERROR(BIF_P,BADARG);
+ }
BIF_RET(res);
-
- list_to_integer_1_error:
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
- BIF_ERROR(BIF_P, BADARG);
-
- }
+}
/**********************************************************************/
@@ -3431,7 +3288,7 @@ static BIF_RETTYPE do_charbuf_to_float(Process *BIF_P,char *buf) {
BIF_RETTYPE list_to_float_1(BIF_ALIST_1)
{
- int i;
+ Sint i;
Eterm res;
char *buf = NULL;
@@ -3548,7 +3405,7 @@ BIF_RETTYPE list_to_tuple_1(BIF_ALIST_1)
Eterm* cons;
Eterm res;
Eterm* hp;
- int len;
+ Sint len;
if ((len = erts_list_length(list)) < 0 || len > ERTS_MAX_TUPLE_SIZE) {
BIF_ERROR(BIF_P, BADARG);
@@ -3824,11 +3681,9 @@ BIF_RETTYPE now_0(BIF_ALIST_0)
BIF_RETTYPE garbage_collect_0(BIF_ALIST_0)
{
- int reds;
-
FLAGS(BIF_P) |= F_NEED_FULLSWEEP;
- reds = erts_garbage_collect(BIF_P, 0, NULL, 0);
- BIF_RET2(am_true, reds);
+ erts_garbage_collect(BIF_P, 0, NULL, 0);
+ BIF_RET(am_true);
}
/**********************************************************************/
@@ -3897,7 +3752,7 @@ BIF_RETTYPE display_string_1(BIF_ALIST_1)
{
Process* p = BIF_P;
Eterm string = BIF_ARG_1;
- int len = is_string(string);
+ Sint len = is_string(string);
char *str;
if (len <= 0) {
@@ -3951,7 +3806,7 @@ BIF_RETTYPE halt_1(BIF_ALIST_1)
erl_exit(ERTS_ABORT_EXIT, "");
}
else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) {
- int i;
+ Sint i;
if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) {
goto error;
@@ -4020,7 +3875,7 @@ BIF_RETTYPE halt_2(BIF_ALIST_2)
erl_exit(ERTS_ABORT_EXIT, "");
}
else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) {
- int i;
+ Sint i;
if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) {
goto error;
@@ -4117,16 +3972,9 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3)
if (arity < 0) {
goto error;
}
-#if HALFWORD_HEAP
- hp = HAlloc(BIF_P, 3);
- hp[0] = HEADER_EXPORT;
- /* Yes, May be misaligned, but X86_64 will fix it... */
- *((Export **) (hp+1)) = erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
-#else
hp = HAlloc(BIF_P, 2);
hp[0] = HEADER_EXPORT;
hp[1] = (Eterm) erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
-#endif
BIF_RET(make_export(hp));
}
@@ -4170,7 +4018,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);
/*
@@ -4487,7 +4335,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
}
} else if (BIF_ARG_1 == make_small(1)) {
int i, max;
- ErlMessage* mp;
+ ErtsMessage* mp;
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_smp_thr_progress_block();
@@ -4580,6 +4428,31 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
default:
ERTS_INTERNAL_ERROR("Unknown state");
}
+#ifdef ERTS_ENABLE_MSACC
+ } else if (BIF_ARG_1 == am_microstate_accounting) {
+ Eterm threads;
+ if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) {
+ erts_aint32_t new = BIF_ARG_2 == am_true ? ERTS_MSACC_ENABLE : ERTS_MSACC_DISABLE;
+ erts_aint32_t old = erts_smp_atomic32_xchg_nob(&msacc, new);
+ Eterm ref = erts_msacc_request(BIF_P, new, &threads);
+ if (is_non_value(ref))
+ BIF_RET(old ? am_true : am_false);
+ BIF_TRAP3(await_msacc_mod_trap,
+ BIF_P,
+ ref,
+ old ? am_true : am_false,
+ threads);
+ } else if (BIF_ARG_2 == am_reset) {
+ Eterm ref = erts_msacc_request(BIF_P, ERTS_MSACC_RESET, &threads);
+ erts_aint32_t old = erts_smp_atomic32_read_nob(&msacc);
+ ASSERT(is_value(ref));
+ BIF_TRAP3(await_msacc_mod_trap,
+ BIF_P,
+ ref,
+ old ? am_true : am_false,
+ threads);
+ }
+#endif
} else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) {
int what;
if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2))
@@ -4632,7 +4505,7 @@ BIF_RETTYPE hash_2(BIF_ALIST_2)
if ((range = signed_val(BIF_ARG_2)) <= 0) { /* [1..MAX_SMALL] */
BIF_ERROR(BIF_P, BADARG);
}
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (range > ((1L << 27) - 1))
BIF_ERROR(BIF_P, BADARG);
#endif
@@ -4704,7 +4577,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)) {
@@ -4909,8 +4782,12 @@ void erts_init_bif(void)
await_port_send_result_trap
= erts_export_put(am_erts_internal, am_await_port_send_result, 3);
await_sched_wall_time_mod_trap
- = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2);
+ = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2);
+ await_msacc_mod_trap
+ = erts_export_put(am_erts_internal, am_await_microstate_accounting_modifications, 3);
+
erts_smp_atomic32_init_nob(&sched_wall_time, 0);
+ erts_smp_atomic32_init_nob(&msacc, ERTS_MSACC_IS_ENABLED());
}
#ifdef HARDDEBUG
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index c6ed60376a..a62eddf36b 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -54,22 +54,24 @@ extern Export *erts_convert_time_unit_trap;
(p)->fcalls = -CONTEXT_REDS; \
} while(0)
-
-#define ERTS_VBUMP_ALL_REDS(p) \
+#define ERTS_VBUMP_ALL_REDS_INTERNAL(p, fcalls) \
do { \
if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) { \
- if ((p)->fcalls > 0) \
- ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (p)->fcalls; \
- (p)->fcalls = 0; \
+ if ((fcalls) > 0) \
+ ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (fcalls); \
+ (fcalls) = 0; \
} \
else { \
- if ((p)->fcalls > -CONTEXT_REDS) \
+ if ((fcalls) > -CONTEXT_REDS) \
ERTS_PROC_GET_SCHDATA((p))->virtual_reds \
- += ((p)->fcalls - (-CONTEXT_REDS)); \
- (p)->fcalls = -CONTEXT_REDS; \
+ += ((fcalls) - (-CONTEXT_REDS)); \
+ (fcalls) = -CONTEXT_REDS; \
} \
} while(0)
+#define ERTS_VBUMP_ALL_REDS(p) \
+ ERTS_VBUMP_ALL_REDS_INTERNAL((p), (p)->fcalls)
+
#define BUMP_REDS(p, gc) do { \
ASSERT(p); \
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));\
@@ -110,10 +112,34 @@ do { \
} \
} while(0)
-#define ERTS_BIF_REDS_LEFT(p) \
+#define ERTS_VBUMP_LEAVE_REDS_INTERNAL(P, Reds, FCalls) \
+ do { \
+ if (ERTS_PROC_GET_SAVED_CALLS_BUF((P))) { \
+ int nreds__ = ((int)(Reds)) - CONTEXT_REDS; \
+ if ((FCalls) > nreds__) { \
+ ERTS_PROC_GET_SCHDATA((P))->virtual_reds \
+ += (FCalls) - nreds__; \
+ (FCalls) = nreds__; \
+ } \
+ } \
+ else { \
+ if ((FCalls) > (Reds)) { \
+ ERTS_PROC_GET_SCHDATA((P))->virtual_reds \
+ += (FCalls) - (Reds); \
+ (FCalls) = (Reds); \
+ } \
+ } \
+ } while (0)
+
+#define ERTS_VBUMP_LEAVE_REDS(P, Reds) \
+ ERTS_VBUMP_LEAVE_REDS_INTERNAL(P, Reds, (P)->fcalls)
+
+#define ERTS_REDS_LEFT(p, FCalls) \
(ERTS_PROC_GET_SAVED_CALLS_BUF((p)) \
- ? ((p)->fcalls > -CONTEXT_REDS ? ((p)->fcalls - (-CONTEXT_REDS)) : 0)\
- : ((p)->fcalls > 0 ? (p)->fcalls : 0))
+ ? ((FCalls) > -CONTEXT_REDS ? ((FCalls) - (-CONTEXT_REDS)) : 0) \
+ : ((FCalls) > 0 ? (FCalls) : 0))
+
+#define ERTS_BIF_REDS_LEFT(p) ERTS_REDS_LEFT(p, p->fcalls)
#define BIF_RET2(x, gc) do { \
BUMP_REDS(BIF_P, (gc)); \
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 3177d5dae7..77d3d95673 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -115,7 +115,7 @@ bif erlang:time_offset/0
bif erlang:time_offset/1
bif erlang:timestamp/0
-bif erlang:open_port/2
+bif erts_internal:open_port/2
bif erlang:pid_to_list/1
bif erlang:ports/0
@@ -125,7 +125,6 @@ bif erlang:process_flag/3
bif erlang:process_info/1
bif erlang:process_info/2
bif erlang:processes/0
-bif erlang:purge_module/1
bif erlang:put/2
bif erlang:register/2
bif erlang:registered/0
@@ -167,10 +166,11 @@ bif erts_internal:request_system_task/3
bif erts_internal:check_process_code/2
bif erts_internal:map_to_tuple_keys/1
-bif erts_internal:map_type/1
+bif erts_internal:term_type/1
bif erts_internal:map_hashmap_children/1
bif erts_internal:time_unit/0
+bif erts_internal:perf_counter_unit/0
bif erts_internal:is_system_process/1
@@ -372,6 +372,7 @@ bif os:getpid/0
bif os:timestamp/0
bif os:system_time/0
bif os:system_time/1
+bif os:perf_counter/0
#
# Bifs in the erl_ddll module (the module actually does not exist)
@@ -641,6 +642,17 @@ bif ets:update_counter/4
bif erts_debug:map_info/1
#
+# New in 19.0
+#
+
+bif erts_internal:copy_literals/2
+bif erts_internal:purge_module/1
+bif binary:split/2
+bif binary:split/3
+bif erts_debug:size_shared/1
+bif erts_debug:copy_shared/1
+
+#
# Obsolete
#
diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c
index 15bcd44fb9..11838e24ef 100644
--- a/erts/emulator/beam/big.c
+++ b/erts/emulator/beam/big.c
@@ -48,7 +48,7 @@
_t_dst = (dst)+((sz)-1); \
_t_src = (src)+((sz)-1); \
while(_t_sz--) *_t_dst-- = *_t_src--; \
- } \
+ } \
} while(0)
/* add a and b with carry in + out */
@@ -423,6 +423,25 @@
#endif
+/* Forward declaration of lookup tables (See below in this file) used in list to
+ * integer conversions for different bases. Also used in bignum printing.
+ */
+static const byte digits_per_sint_lookup[36-1];
+static const byte digits_per_small_lookup[36-1];
+static const Sint largest_power_of_base_lookup[36-1];
+
+static ERTS_INLINE byte get_digits_per_signed_int(Uint base) {
+ return digits_per_sint_lookup[base-2];
+}
+
+static ERTS_INLINE byte get_digits_per_small(Uint base) {
+ return digits_per_small_lookup[base-2];
+}
+
+static ERTS_INLINE Sint get_largest_power_of_base(Uint base) {
+ return largest_power_of_base_lookup[base-2];
+}
+
/*
** compare two number vectors
*/
@@ -1487,20 +1506,8 @@ Eterm uint_to_big(Uint x, Eterm *y)
Eterm uword_to_big(UWord x, Eterm *y)
{
-#if HALFWORD_HEAP
- Uint upper = x >> 32;
- Uint lower = x & 0xFFFFFFFFUL;
- if (upper == 0) {
- *y = make_pos_bignum_header(1);
- } else {
- *y = make_pos_bignum_header(2);
- BIG_DIGIT(y, 1) = upper;
- }
- BIG_DIGIT(y, 0) = lower;
-#else
*y = make_pos_bignum_header(1);
BIG_DIGIT(y, 0) = x;
-#endif
return make_big(y);
}
@@ -1525,7 +1532,7 @@ Eterm small_to_big(Sint x, Eterm *y)
Eterm erts_uint64_to_big(Uint64 x, Eterm **hpp)
{
Eterm *hp = *hpp;
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
if (x >= (((Uint64) 1) << 32)) {
*hp = make_pos_bignum_header(2);
BIG_DIGIT(hp, 0) = (Uint) (x & ((Uint) 0xffffffff));
@@ -1555,7 +1562,7 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp)
neg = 1;
ux = -(Uint64)x;
}
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
if (ux >= (((Uint64) 1) << 32)) {
if (neg)
*hp = make_neg_bignum_header(2);
@@ -1588,7 +1595,7 @@ erts_uint64_array_to_big(Uint **hpp, int neg, int len, Uint64 *array)
pot_digits = digits = 0;
for (i = 0; i < len; i++) {
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
Uint low_val = array[i] & ((Uint) 0xffffffff);
Uint high_val = (array[i] >> 32) & ((Uint) 0xffffffff);
BIG_DIGIT(headerp, pot_digits) = low_val;
@@ -1651,8 +1658,6 @@ big_to_double(Wterm x, double* resp)
/*
* Logic has been copied from erl_bif_guard.c and slightly
* modified to use a static instead of dynamic heap
- *
- * HALFWORD: Return relative term with 'heap' as base.
*/
Eterm
double_to_big(double x, Eterm *heap, Uint hsz)
@@ -1683,7 +1688,7 @@ double_to_big(double x, Eterm *heap, Uint hsz)
sz = BIG_NEED_SIZE(ds); /* number of words including arity */
hp = heap;
- res = make_big_rel(hp, heap);
+ res = make_big(hp);
xp = (ErtsDigit*) (hp + 1);
ASSERT(ds < hsz);
@@ -1733,8 +1738,10 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg)
short sign = BIG_SIGN(xp);
ErtsDigit rem;
Uint n = 0;
+ const Uint digits_per_Sint = get_digits_per_signed_int(10);
+ const Sint largest_pow_of_base = get_largest_power_of_base(10);
- if (xl == 1 && *dx < D_DECIMAL_BASE) {
+ if (xl == 1 && *dx < largest_pow_of_base) {
rem = *dx;
if (rem == 0) {
(*write_func)(arg, '0'); n++;
@@ -1752,7 +1759,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg)
MOVE_DIGITS(tmp, dx, xl);
while(1) {
- tmpl = D_div(tmp, tmpl, D_DECIMAL_BASE, tmp, &rem);
+ tmpl = D_div(tmp, tmpl, largest_pow_of_base, tmp, &rem);
if (tmpl == 1 && *tmp == 0) {
while(rem) {
(*write_func)(arg, (rem % 10)+'0'); n++;
@@ -1760,7 +1767,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg)
}
break;
} else {
- int i = D_DECIMAL_EXP;
+ Uint i = digits_per_Sint;
while(i--) {
(*write_func)(arg, (rem % 10)+'0'); n++;
rem /= 10;
@@ -2536,63 +2543,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
+};
+
+/*
+ * How many digits can fit into Erlang Small (SMALL_BITS-1) counting sign bit
+ */
+static const byte digits_per_small_lookup[36-1] = {
+#if (SIZEOF_VOID_P == 4)
+ /* Wo.Alpha formula: Table [Trunc[27 / log[2,n]]-1, {n, 2, 36}] */
+ 27, 17, 13, 11, 10, 9, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5,
+ 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5
+#elif (SIZEOF_VOID_P == 8)
+ /* Wo.Alpha formula: Table [Trunc[59 / log[2,n]]-1, {n, 2, 36}] */
+ 59, 37, 29, 25, 22, 21, 19, 18, 17, 17, 16, 15, 15, 15, 14, 14, 14, 13, 13,
+ 13, 13, 13, 12, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11
+#else
+ #error "Please produce a lookup table for the new architecture"
+#endif
+};
/*
- * for i in 2..64 do
- * d_base_base_lookup[i-2] = pow(i,d_base_exp_lookup[i-2]);
- * end
- * How much can the characters which fit in 31 bit represent
+ * Largest power of base which can be represented in a signed int (Sint).
+ * Calculated by base 2..36 to the power of corresponding element from
+ * digits_per_sint_lookup.
*/
-const Uint d_base_base_lookup[] = { 2147483648u, 1162261467u, 1073741824u,
- 1220703125u, 362797056u, 1977326743u, 1073741824u, 387420489u,
- 1000000000u, 214358881u, 429981696u, 815730721u, 1475789056u,
- 170859375u, 268435456u, 410338673u, 612220032u, 893871739u, 1280000000u,
- 1801088541u, 113379904u, 148035889u, 191102976u, 244140625u, 308915776u,
- 387420489u, 481890304u, 594823321u, 729000000u, 887503681u, 1073741824u,
- 1291467969u, 1544804416u, 1838265625u, 60466176u, 69343957u, 79235168u,
- 90224199u, 102400000u, 115856201u, 130691232u, 147008443u, 164916224u,
- 184528125u, 205962976u, 229345007u, 254803968u, 282475249u, 312500000u,
- 345025251u, 380204032u, 418195493u, 459165024u, 503284375u, 550731776u,
- 601692057u, 656356768u, 714924299u, 777600000u, 844596301u, 916132832u,
- 992436543u, 1073741824u };
+static const Sint largest_power_of_base_lookup[36-1] = {
+#if (SIZEOF_VOID_P == 4)
+ /* Wo.Alpha formula: Table [Pow[n, Trunc[31 / log[2,n]]-1], {n, 2, 36}] */
+ 1073741824, 387420489, 268435456, 244140625, 60466176, 282475249, 134217728,
+ 43046721, 100000000, 19487171, 35831808, 62748517, 105413504, 11390625,
+ 16777216, 24137569, 34012224, 47045881, 64000000, 85766121, 5153632,
+ 6436343,7962624, 9765625, 11881376, 14348907, 17210368, 20511149, 24300000,
+ 28629151, 33554432, 39135393, 45435424, 52521875, 1679616
+#elif (SIZEOF_VOID_P == 8)
+ /* Wo.Alpha formula: Table [Pow[n, Trunc[63 / log[2,n]]-1], {n, 2, 36}]
+ * with LL added after each element manually */
+ 4611686018427387904LL, 1350851717672992089LL, 1152921504606846976LL,
+ 1490116119384765625LL, 789730223053602816LL, 558545864083284007LL,
+ 1152921504606846976LL, 150094635296999121LL, 100000000000000000LL,
+ 505447028499293771LL, 184884258895036416LL, 665416609183179841LL,
+ 155568095557812224LL, 437893890380859375LL, 72057594037927936LL,
+ 168377826559400929LL, 374813367582081024LL, 42052983462257059LL,
+ 81920000000000000LL, 154472377739119461LL, 282810057883082752LL,
+ 21914624432020321LL, 36520347436056576LL, 59604644775390625LL,
+ 95428956661682176LL, 150094635296999121LL, 232218265089212416LL,
+ 12200509765705829LL, 17714700000000000LL, 25408476896404831LL,
+ 36028797018963968LL, 50542106513726817LL, 70188843638032384LL,
+ 96549157373046875LL, 131621703842267136LL
+#else
+ #error "Please produce a lookup table for the new architecture"
+#endif
+};
Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
Uint size, const int base) {
@@ -2602,8 +2646,11 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
int neg = 0;
byte b;
Eterm *hp, *hp_end;
- int m;
+ Sint m;
int lg2;
+ const Uint digits_per_small = get_digits_per_small(base);
+ const Uint digits_per_Sint = get_digits_per_signed_int(base);
+ const Sint largest_pow_of_base = get_largest_power_of_base(base);
if (size == 0)
goto bytebuf_to_integer_1_error;
@@ -2618,57 +2665,68 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
size--;
}
+ /* Trim leading zeroes */
+ if (size) {
+ while (*bytes == '0') {
+ bytes++;
+ size--;
+ if (!size) {
+ /* All zero! */
+ res = make_small(0);
+ goto bytebuf_to_integer_1_done;
+ }
+ }
+ }
+
if (size == 0)
goto bytebuf_to_integer_1_error;
- if (size < SMALL_DIGITS && base <= 10) {
- /* *
- * Take shortcut if we know that all chars are '0' < b < '9' and
- * fit in a small. This improves speed by about 10% over the generic
- * small case.
- * */
- while (size--) {
- b = *bytes++;
+ if (size < digits_per_small) {
+ if (base <= 10) {
+ /* *
+ * Take shortcut if we know that all chars are '0' < b < '9' and
+ * fit in a small. This improves speed by about 10% over the generic
+ * small case.
+ * */
+ while (size--) {
+ b = *bytes++;
- if (b < '0' || b > ('0'+base-1))
- goto bytebuf_to_integer_1_error;
+ if (b < '0' || b > ('0'+base-1))
+ goto bytebuf_to_integer_1_error;
- i = i * base + b - '0';
- }
+ i = i * base + b - '0';
+ }
- if (neg)
- i = -i;
- res = make_small(i);
- goto bytebuf_to_integer_1_done;
+ if (neg)
+ i = -i;
+ res = make_small(i);
+ goto bytebuf_to_integer_1_done;
+ }
+
+ /* Take shortcut if we know it will fit in a small.
+ * This improves speed by about 30%.
+ */
+ while (size) {
+ b = *bytes++;
+ size--;
+
+ if (c2int_is_invalid_char(b, base))
+ goto bytebuf_to_integer_1_error;
+
+ i = i * base + c2int_digit_from_base(b);
+ }
+
+ if (neg)
+ i = -i;
+ res = make_small(i);
+ goto bytebuf_to_integer_1_done;
}
/*
* Calculate the maximum number of bits which will
* be needed to represent the binary
*/
- lg2 = ((size+2)*LG2_LOOKUP(base)+1);
-
- if (lg2 < SMALL_BITS) {
- /* Take shortcut if we know it will fit in a small.
- * This improves speed by about 30%.
- */
- while (size) {
- b = *bytes++;
- size--;
-
- if (IS_VALID_CHARACTER(b,base))
- goto bytebuf_to_integer_1_error;
-
- i = i * base + CHARACTER_FROM_BASE(b);
-
- }
-
- if (neg)
- i = -i;
- res = make_small(i);
- goto bytebuf_to_integer_1_done;
-
- }
+ lg2 = ((size+2)*lookup_log2(base)+1);
/* Start calculating bignum */
m = (lg2 + D_EXP-1)/D_EXP;
@@ -2677,8 +2735,8 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
hp = HAlloc(BIF_P, m);
hp_end = hp + m;
- if ((i = (size % D_BASE_EXP(base))) == 0)
- i = D_BASE_EXP(base);
+ if ((i = (size % digits_per_Sint)) == 0)
+ i = digits_per_Sint;
n = size - i;
m = 0;
@@ -2686,34 +2744,34 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
while (i--) {
b = *bytes++;
- if (IS_VALID_CHARACTER(b,base)) {
+ if (c2int_is_invalid_char(b,base)) {
HRelease(BIF_P, hp_end, hp);
goto bytebuf_to_integer_1_error;
}
- m = base * m + CHARACTER_FROM_BASE(b);
+ m = base * m + c2int_digit_from_base(b);
}
res = small_to_big(m, hp);
while (n) {
- i = D_BASE_EXP(base);
- n -= D_BASE_EXP(base);
+ i = digits_per_Sint;
+ n -= digits_per_Sint;
m = 0;
while (i--) {
b = *bytes++;
- if (IS_VALID_CHARACTER(b,base)) {
+ if (c2int_is_invalid_char(b,base)) {
HRelease(BIF_P, hp_end, hp);
goto bytebuf_to_integer_1_error;
}
- m = base * m + CHARACTER_FROM_BASE(b);
+ m = base * m + c2int_digit_from_base(b);
}
if (is_small(res)) {
res = small_to_big(signed_val(res), hp);
}
- res = big_times_small(res, D_BASE_BASE(base), hp);
+ res = big_times_small(res, largest_pow_of_base, hp);
if (is_small(res)) {
res = small_to_big(signed_val(res), hp);
}
@@ -2744,5 +2802,166 @@ bytebuf_to_integer_1_error:
bytebuf_to_integer_1_done:
return res;
+}
+/* Converts list of digits with given 'base' to integer sequentially. Returns
+ * result in 'integer_out', remaining tail goes to 'tail_out' and returns result
+ * code if the list was consumed fully or partially or there was an error
+ */
+LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list,
+ const Uint base,
+ Eterm *integer_out, Eterm *tail_out)
+{
+ Sint i = 0;
+ Uint ui = 0;
+ int skip = 0;
+ int neg = 0;
+ Sint n = 0;
+ Sint m;
+ int lg2;
+ Eterm res;
+ Eterm lst = orig_list;
+ Eterm tail = lst;
+ int error_res = LTI_BAD_STRUCTURE;
+ const Uint digits_per_small = get_digits_per_small(base);
+ const Uint digits_per_Sint = get_digits_per_signed_int(base);
+
+ if (is_nil(lst)) {
+ error_res = LTI_NO_INTEGER;
+ error:
+ *tail_out = tail;
+ *integer_out = make_small(0);
+ return error_res;
+ }
+ if (is_not_list(lst))
+ goto error;
+
+ /* if first char is a '-' then it is a negative integer */
+ if (CAR(list_val(lst)) == make_small('-')) {
+ neg = 1;
+ skip = 1;
+ lst = CDR(list_val(lst));
+ if (is_not_list(lst)) {
+ tail = lst;
+ error_res = LTI_NO_INTEGER;
+ goto error;
+ }
+ } else if (CAR(list_val(lst)) == make_small('+')) {
+ /* ignore plus */
+ skip = 1;
+ lst = CDR(list_val(lst));
+ if (is_not_list(lst)) {
+ tail = lst;
+ error_res = LTI_NO_INTEGER;
+ goto error;
+ }
+ }
+
+ /* Calculate size and do type check */
+
+ while(1) {
+ byte ch;
+ if (is_not_small(CAR(list_val(lst)))) {
+ break;
+ }
+ ch = unsigned_val(CAR(list_val(lst)));
+ if (c2int_is_invalid_char(ch, base)) {
+ break;
+ }
+ ui = ui * base;
+ ui = ui + c2int_digit_from_base(ch);
+ n++;
+ lst = CDR(list_val(lst));
+ if (is_nil(lst)) {
+ break;
+ }
+ if (is_not_list(lst)) {
+ break;
+ }
+ }
+
+ tail = lst;
+ if (!n) {
+ error_res = LTI_NO_INTEGER;
+ goto error;
+ }
+
+
+ /* If length fits inside Sint then we know it's a small int. Else we
+ * must construct a bignum and let that routine do the checking
+ */
+
+ if (n <= digits_per_small) { /* It must be small */
+ i = neg ? -(Sint)ui : (Sint)ui;
+ res = make_small(i);
+ } else {
+ const Sint largest_pow_of_base = get_largest_power_of_base(base);
+ Eterm *hp;
+ Eterm *hp_end;
+
+ /* Convert from log_base to log2 using lookup table */
+ lg2 = ((n+2)*lookup_log2(base)+1);
+ m = (lg2+D_EXP-1)/D_EXP; /* number of digits */
+ m = BIG_NEED_SIZE(m); /* number of words + thing */
+
+ hp = HAlloc(BIF_P, m);
+ hp_end = hp + m;
+
+ lst = orig_list;
+ if (skip)
+ lst = CDR(list_val(lst));
+
+ /* load first digits (at least one digit) */
+ if ((i = (n % digits_per_Sint)) == 0)
+ i = digits_per_Sint;
+ n -= i;
+ m = 0;
+ while(i--) {
+ m *= base;
+ m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst))));
+ lst = CDR(list_val(lst));
+ }
+ res = small_to_big(m, hp); /* load first digits */
+
+ while(n) {
+ i = digits_per_Sint;
+ n -= digits_per_Sint;
+ m = 0;
+ while(i--) {
+ m *= base;
+ m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst))));
+ lst = CDR(list_val(lst));
+ }
+ if (is_small(res))
+ res = small_to_big(signed_val(res), hp);
+ res = big_times_small(res, largest_pow_of_base, hp);
+ if (is_small(res))
+ res = small_to_big(signed_val(res), hp);
+ res = big_plus_small(res, m, hp);
+ }
+
+ if (neg) {
+ if (is_small(res))
+ res = make_small(-signed_val(res));
+ else {
+ Uint *big = big_val(res); /* point to thing */
+ *big = bignum_header_neg(*big);
+ }
+ }
+
+ if (is_not_small(res)) {
+ res = big_plus_small(res, 0, hp); /* includes conversion to small */
+
+ if (is_not_small(res)) {
+ hp += (big_arity(res)+1);
+ }
+ }
+ HRelease(BIF_P, hp_end, hp);
+ }
+ *integer_out = res;
+ *tail_out = tail;
+ if (tail != NIL) {
+ return LTI_SOME_INTEGER;
+ }
+ return LTI_ALL_INTEGER;
}
diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h
index 4aa9724ae3..9c92de6b55 100644
--- a/erts/emulator/beam/big.h
+++ b/erts/emulator/beam/big.h
@@ -35,7 +35,7 @@
typedef Uint ErtsDigit;
-#if ((SIZEOF_VOID_P == 4) || HALFWORD_HEAP) && defined(SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG == 8)
+#if (SIZEOF_VOID_P == 4) && defined(SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG == 8)
/* Assume 32-bit machine with long long support */
typedef Uint64 ErtsDoubleDigit;
typedef Uint16 ErtsHalfDigit;
@@ -54,9 +54,6 @@ typedef Uint32 ErtsHalfDigit;
#error "can not determine machine size"
#endif
-#define D_DECIMAL_EXP 9
-#define D_DECIMAL_BASE 1000000000
-
typedef Uint dsize_t; /* Vector size type */
#define D_EXP (ERTS_SIZEOF_ETERM*8)
@@ -90,13 +87,9 @@ typedef Uint dsize_t; /* Vector size type */
#define BIG_UINT_HEAP_SIZE (1 + 1) /* always, since sizeof(Uint) <= sizeof(Eterm) */
-#if HALFWORD_HEAP
-#define BIG_UWORD_HEAP_SIZE(UW) (((UW) >> (sizeof(Uint) * 8)) ? 3 : 2)
-#else
#define BIG_UWORD_HEAP_SIZE(UW) BIG_UINT_HEAP_SIZE
-#endif
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
#define ERTS_UINT64_BIG_HEAP_SIZE__(X) \
((X) >= (((Uint64) 1) << 32) ? (1 + 2) : (1 + 1))
@@ -177,5 +170,15 @@ Eterm erts_sint64_to_big(Sint64, Eterm **);
Eterm erts_chars_to_integer(Process *, char*, Uint, const int);
+/* How list_to_integer classifies the input, was it even a string? */
+typedef enum {
+ LTI_BAD_STRUCTURE = 0,
+ LTI_NO_INTEGER = 1,
+ LTI_SOME_INTEGER = 2,
+ LTI_ALL_INTEGER = 3
+} LTI_result_t;
+
+LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list,
+ const Uint base,
+ Eterm *integer_out, Eterm *tail_out);
#endif
-
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index e670fbf31c..d3e481c7f9 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -34,6 +34,9 @@
#include "erl_binary.h"
#include "erl_bits.h"
+#define L2B_B2L_MIN_EXEC_REDS (CONTEXT_REDS/4)
+#define L2B_B2L_RESCHED_REDS (CONTEXT_REDS/40)
+
static Export binary_to_list_continue_export;
static Export list_to_binary_continue_export;
@@ -415,10 +418,10 @@ binary_to_list_chunk(Process *c_p,
}
static ERTS_INLINE BIF_RETTYPE
-binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, Uint size, Uint bitoffs)
+binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes,
+ Uint size, Uint bitoffs, int reds_left, int one_chunk)
{
- int reds_left = ERTS_BIF_REDS_LEFT(c_p);
- if (size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION) {
+ if (one_chunk) {
Eterm res;
BIF_RETTYPE ret;
int bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1;
@@ -472,11 +475,29 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1)
Uint size;
Uint bitsize;
Uint bitoffs;
+ int reds_left;
+ int one_chunk;
if (is_not_binary(BIF_ARG_1)) {
goto error;
}
+
size = binary_size(BIF_ARG_1);
+ reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
+ one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION;
+ if (!one_chunk) {
+ if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) {
+ if (reds_left <= L2B_B2L_RESCHED_REDS) {
+ /* Yield and do it with full context reds... */
+ ERTS_BIF_YIELD1(bif_export[BIF_binary_to_list_1],
+ BIF_P, BIF_ARG_1);
+ }
+ /* Allow a bit more reductions... */
+ one_chunk = 1;
+ reds_left = L2B_B2L_MIN_EXEC_REDS;
+ }
+ }
+
ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize);
if (bitsize != 0) {
goto error;
@@ -486,7 +507,8 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1)
} else {
Eterm* hp = HAlloc(BIF_P, 2 * size);
byte* bytes = binary_bytes(real_bin)+offset;
- return binary_to_list(BIF_P, hp, NIL, bytes, size, bitoffs);
+ return binary_to_list(BIF_P, hp, NIL, bytes, size,
+ bitoffs, reds_left, one_chunk);
}
error:
@@ -505,6 +527,8 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
Uint start;
Uint stop;
Eterm* hp;
+ int reds_left;
+ int one_chunk;
if (is_not_binary(BIF_ARG_1)) {
goto error;
@@ -513,6 +537,21 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
goto error;
}
size = binary_size(BIF_ARG_1);
+ reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
+ one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION;
+ if (!one_chunk) {
+ if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) {
+ if (reds_left <= L2B_B2L_RESCHED_REDS) {
+ /* Yield and do it with full context reds... */
+ ERTS_BIF_YIELD3(bif_export[BIF_binary_to_list_3],
+ BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ }
+ /* Allow a bit more reductions... */
+ one_chunk = 1;
+ reds_left = L2B_B2L_MIN_EXEC_REDS;
+ }
+ }
+
ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize);
if (start < 1 || start > size || stop < 1 ||
stop > size || stop < start ) {
@@ -520,7 +559,8 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
}
i = stop-start+1;
hp = HAlloc(BIF_P, 2*i);
- return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i, bitoffs);
+ return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i,
+ bitoffs, reds_left, one_chunk);
error:
BIF_ERROR(BIF_P, BADARG);
}
@@ -537,11 +577,27 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
byte* bytes;
Eterm previous = NIL;
Eterm* hp;
+ int reds_left;
+ int one_chunk;
if (is_not_binary(BIF_ARG_1)) {
BIF_ERROR(BIF_P, BADARG);
}
size = binary_size(BIF_ARG_1);
+ reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
+ one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION;
+ if (!one_chunk) {
+ if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) {
+ if (reds_left <= L2B_B2L_RESCHED_REDS) {
+ /* Yield and do it with full context reds... */
+ ERTS_BIF_YIELD1(bif_export[BIF_bitstring_to_list_1],
+ BIF_P, BIF_ARG_1);
+ }
+ /* Allow a bit more reductions... */
+ one_chunk = 1;
+ reds_left = L2B_B2L_MIN_EXEC_REDS;
+ }
+ }
ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize);
bytes = binary_bytes(real_bin)+offset;
if (bitsize == 0) {
@@ -566,7 +622,8 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
hp += 2;
}
- return binary_to_list(BIF_P, hp, previous, bytes, size, bitoffs);
+ return binary_to_list(BIF_P, hp, previous, bytes, size,
+ bitoffs, reds_left, one_chunk);
}
@@ -795,8 +852,19 @@ static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1)
BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif)
{
+ int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p);
BIF_RETTYPE ret;
+ if (orig_reds_left < L2B_B2L_MIN_EXEC_REDS) {
+ if (orig_reds_left <= L2B_B2L_RESCHED_REDS) {
+ /* Yield and do it with full context reds... */
+ ERTS_BIF_PREP_YIELD1(ret, bif, c_p, arg);
+ return ret;
+ }
+ /* Allow a bit more reductions... */
+ orig_reds_left = L2B_B2L_MIN_EXEC_REDS;
+ }
+
if (is_nil(arg))
ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) "", 0));
else if (is_not_list(arg))
@@ -818,7 +886,6 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif)
bif,
erts_iolist_size_yielding,
erts_iolist_to_buf_yielding);
- int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p);
/*
* First try to do it all at once without having to use
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 4ce9d24479..2c8ecf04be 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -252,7 +252,7 @@ print_process_info(int to, void *to_arg, Process *p)
/* display the message queue only if there is anything in it */
if (!ERTS_IS_CRASH_DUMPING && p->msg.first != NULL && !garbing) {
- ErlMessage* mp;
+ ErtsMessage* mp;
erts_print(to, to_arg, "Message queue: [");
for (mp = p->msg.first; mp; mp = mp->next)
erts_print(to, to_arg, mp->next ? "%T," : "%T", ERL_MESSAGE_TERM(mp));
@@ -323,7 +323,7 @@ print_process_info(int to, void *to_arg, Process *p)
erts_print(to, to_arg, "Heap unused: %bpu\n", (p->hend - p->htop));
erts_print(to, to_arg, "OldHeap unused: %bpu\n",
(OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HTOP(p)) );
- erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p));
+ erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p, !0));
if (garbing) {
print_garb_info(to, to_arg, p);
@@ -381,7 +381,7 @@ loaded(int to, void *to_arg)
int i;
int old = 0;
int cur = 0;
- BeamInstr* code;
+ BeamCodeHeader* code;
Module* modp;
ErtsCodeIndex code_ix;
@@ -439,30 +439,30 @@ loaded(int to, void *to_arg)
erts_print(to, to_arg, "\n");
erts_print(to, to_arg, "Current size: %d\n",
modp->curr.code_length);
- code = modp->curr.code;
- if (code != NULL && code[MI_ATTR_PTR]) {
+ code = modp->curr.code_hdr;
+ if (code != NULL && code->attr_ptr) {
erts_print(to, to_arg, "Current attributes: ");
- dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR],
- code[MI_ATTR_SIZE]);
+ dump_attributes(to, to_arg, code->attr_ptr,
+ code->attr_size);
}
- if (code != NULL && code[MI_COMPILE_PTR]) {
+ if (code != NULL && code->compile_ptr) {
erts_print(to, to_arg, "Current compilation info: ");
- dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR],
- code[MI_COMPILE_SIZE]);
+ dump_attributes(to, to_arg, code->compile_ptr,
+ code->compile_size);
}
if (modp->old.code_length != 0) {
erts_print(to, to_arg, "Old size: %d\n", modp->old.code_length);
- code = modp->old.code;
- if (code[MI_ATTR_PTR]) {
+ code = modp->old.code_hdr;
+ if (code->attr_ptr) {
erts_print(to, to_arg, "Old attributes: ");
- dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR],
- code[MI_ATTR_SIZE]);
+ dump_attributes(to, to_arg, code->attr_ptr,
+ code->attr_size);
}
- if (code[MI_COMPILE_PTR]) {
+ if (code->compile_ptr) {
erts_print(to, to_arg, "Old compilation info: ");
- dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR],
- code[MI_COMPILE_SIZE]);
+ dump_attributes(to, to_arg, code->compile_ptr,
+ code->compile_size);
}
}
}
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 8849dadd00..67a96f6442 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -35,56 +35,59 @@
#include "erl_bits.h"
#include "dtrace-wrapper.h"
-static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*);
+static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*, int);
/*
* Copy object "obj" to process p.
*/
-Eterm
-copy_object(Eterm obj, Process* to)
-{
- Uint size = size_object(obj);
- Eterm* hp = HAlloc(to, size);
- Eterm res;
+Eterm copy_object_x(Eterm obj, Process* to, Uint extra) {
+ if (!is_immed(obj)) {
+ Uint size = size_object(obj);
+ Eterm* hp = HAllocX(to, size, extra);
+ Eterm res;
#ifdef USE_VM_PROBES
- if (DTRACE_ENABLED(copy_object)) {
- DTRACE_CHARBUF(proc_name, 64);
+ if (DTRACE_ENABLED(copy_object)) {
+ DTRACE_CHARBUF(proc_name, 64);
- erts_snprintf(proc_name, sizeof(DTRACE_CHARBUF_NAME(proc_name)),
- "%T", to->common.id);
- DTRACE2(copy_object, proc_name, size);
- }
+ erts_snprintf(proc_name, sizeof(DTRACE_CHARBUF_NAME(proc_name)),
+ "%T", to->common.id);
+ DTRACE2(copy_object, proc_name, size);
+ }
#endif
- res = copy_struct(obj, size, &hp, &to->off_heap);
+ res = copy_struct(obj, size, &hp, &to->off_heap);
#ifdef DEBUG
- if (eq(obj, res) == 0) {
- erl_exit(ERTS_ABORT_EXIT, "copy not equal to source\n");
- }
+ if (eq(obj, res) == 0) {
+ erl_exit(ERTS_ABORT_EXIT, "copy not equal to source\n");
+ }
#endif
- return res;
+ return res;
+ }
+ return obj;
}
/*
* Return the "flat" size of the object.
*/
-#if HALFWORD_HEAP
-Uint size_object_rel(Eterm obj, Eterm* base)
-#else
Uint size_object(Eterm obj)
-#endif
{
Uint sum = 0;
Eterm* ptr;
int arity;
+#ifdef DEBUG
+ Eterm mypid = erts_get_current_pid();
+#endif
DECLARE_ESTACK(s);
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size_object %p\n", mypid, obj));
+
for (;;) {
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
sum += 2;
- ptr = list_val_rel(obj,base);
+ ptr = list_val(obj);
obj = *ptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
@@ -93,11 +96,11 @@ Uint size_object(Eterm obj)
break;
case TAG_PRIMARY_BOXED:
{
- Eterm hdr = *boxed_val_rel(obj,base);
+ Eterm hdr = *boxed_val(obj);
ASSERT(is_header(hdr));
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
- ptr = tuple_val_rel(obj,base);
+ ptr = tuple_val(obj);
arity = header_arity(hdr);
sum += arity + 1;
if (arity == 0) { /* Empty tuple -- unusual. */
@@ -113,7 +116,7 @@ Uint size_object(Eterm obj)
break;
case FUN_SUBTAG:
{
- Eterm* bptr = fun_val_rel(obj,base);
+ Eterm* bptr = fun_val(obj);
ErlFunThing* funp = (ErlFunThing *) bptr;
unsigned eterms = 1 /* creator */ + funp->num_free;
unsigned sz = thing_arityval(hdr);
@@ -134,7 +137,7 @@ Uint size_object(Eterm obj)
{
Uint n;
flatmap_t *mp;
- mp = (flatmap_t*)flatmap_val_rel(obj,base);
+ mp = (flatmap_t*)flatmap_val(obj);
ptr = (Eterm *)mp;
n = flatmap_get_size(mp) + 1;
sum += n + 2;
@@ -153,7 +156,7 @@ Uint size_object(Eterm obj)
{
Eterm *head;
Uint sz;
- head = hashmap_val_rel(obj, base);
+ head = hashmap_val(obj);
sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
sum += 1 + sz + header_arity(hdr);
head += 1 + header_arity(hdr);
@@ -182,7 +185,7 @@ Uint size_object(Eterm obj)
Uint bitoffs;
Uint extra_bytes;
Eterm hdr;
- ERTS_GET_REAL_BIN_REL(obj, real_bin, offset, bitoffs, bitsize, base);
+ ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
if ((bitsize + bitoffs) > 8) {
sum += ERL_SUB_BIN_SIZE;
extra_bytes = 2;
@@ -192,11 +195,11 @@ 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;
}
@@ -214,6 +217,7 @@ 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);
@@ -225,14 +229,377 @@ Uint size_object(Eterm obj)
}
/*
+ * Machinery for sharing preserving information
+ * Using a WSTACK but not very transparently; consider refactoring
+ */
+
+#define DECLARE_BITSTORE(s) \
+ DECLARE_WSTACK(s); \
+ int WSTK_CONCAT(s,_bitoffs) = 0; \
+ int WSTK_CONCAT(s,_offset) = 0; \
+ UWord WSTK_CONCAT(s,_buffer) = 0
+
+#define DESTROY_BITSTORE(s) DESTROY_WSTACK(s)
+#define BITSTORE_PUT(s,i) \
+do { \
+ WSTK_CONCAT(s,_buffer) |= i << WSTK_CONCAT(s,_bitoffs); \
+ WSTK_CONCAT(s,_bitoffs) += 2; \
+ if (WSTK_CONCAT(s,_bitoffs) >= 8*sizeof(UWord)) { \
+ WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \
+ WSTK_CONCAT(s,_bitoffs) = 0; \
+ WSTK_CONCAT(s,_buffer) = 0; \
+ } \
+} while(0)
+#define BITSTORE_CLOSE(s) \
+do { \
+ if (WSTK_CONCAT(s,_bitoffs) > 0) { \
+ WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \
+ WSTK_CONCAT(s,_bitoffs) = 0; \
+ } \
+} while(0)
+
+#define BITSTORE_FETCH(s,dst) \
+do { \
+ UWord result; \
+ if (WSTK_CONCAT(s,_bitoffs) <= 0) { \
+ WSTK_CONCAT(s,_buffer) = s.wstart[WSTK_CONCAT(s,_offset)]; \
+ WSTK_CONCAT(s,_offset)++; \
+ WSTK_CONCAT(s,_bitoffs) = 8*sizeof(UWord); \
+ } \
+ WSTK_CONCAT(s,_bitoffs) -= 2; \
+ result = WSTK_CONCAT(s,_buffer) & 3; \
+ WSTK_CONCAT(s,_buffer) >>= 2; \
+ (dst) = result; \
+} while(0)
+
+#define BOXED_VISITED_MASK ((Eterm) 3)
+#define BOXED_VISITED ((Eterm) 1)
+#define BOXED_SHARED_UNPROCESSED ((Eterm) 2)
+#define BOXED_SHARED_PROCESSED ((Eterm) 3)
+
+#define COUNT_OFF_HEAP (0)
+
+#define IN_LITERAL_PURGE_AREA(info, ptr) \
+ ((info)->range_ptr && ( \
+ (info)->range_ptr <= (ptr) && \
+ (ptr) < ((info)->range_ptr + (info)->range_sz)))
+/*
+ * Return the real size of an object and find sharing information
+ * This currently returns the same as erts_debug:size/1.
+ * It is argued whether the size of subterms in constant pools
+ * should be counted or not.
+ */
+
+Uint size_shared(Eterm obj)
+{
+ Eterm saved_obj = obj;
+ Uint sum = 0;
+ Eterm* ptr;
+
+ DECLARE_EQUEUE(s);
+ DECLARE_BITSTORE(b);
+
+ for (;;) {
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ ptr = list_val(obj);
+ /* we're not counting anything that's outside our heap */
+ if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) {
+ goto pop_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if it's visited, don't count it */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER ||
+ primary_tag(head) == TAG_PRIMARY_HEADER) {
+ goto pop_next;
+ }
+ /* else make it visited now */
+ switch (primary_tag(tail)) {
+ case TAG_PRIMARY_LIST:
+ ptr[1] = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER;
+ break;
+ case TAG_PRIMARY_IMMED1:
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head);
+ break;
+ case TAG_PRIMARY_BOXED:
+ BITSTORE_PUT(b, primary_tag(head));
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER;
+ break;
+ }
+ /* and count it */
+ sum += 2;
+ if (!IS_CONST(head)) {
+ EQUEUE_PUT(s, head);
+ }
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ ptr = boxed_val(obj);
+ /* we're not counting anything that's outside our heap */
+ if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) {
+ goto pop_next;
+ }
+ hdr = *ptr;
+ /* if it's visited, don't count it */
+ if (primary_tag(hdr) != TAG_PRIMARY_HEADER) {
+ goto pop_next;
+ }
+ /* else make it visited now */
+ *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED;
+ /* and count it */
+ ASSERT(is_header(hdr));
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ sum += arity + 1;
+ if (arity == 0) { /* Empty tuple -- unusual. */
+ goto pop_next;
+ }
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ unsigned sz = thing_arityval(hdr);
+ sum += 1 /* header */ + sz + eterms;
+ ptr += 1 /* header */ + sz;
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case SUB_BINARY_SUBTAG: {
+ ErlSubBin* sb = (ErlSubBin *) ptr;
+ Uint extra_bytes;
+ Eterm hdr;
+ ASSERT((sb->thing_word & ~BOXED_VISITED_MASK) == HEADER_SUB_BIN);
+ if (sb->bitsize + sb->bitoffs > 8) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 2;
+ } else if (sb->bitsize + sb->bitoffs > 0) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 1;
+ } else {
+ extra_bytes = 0;
+ }
+ ptr = binary_val(sb->orig);
+ hdr = (*ptr) & ~BOXED_VISITED_MASK;
+ if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) {
+ sum += PROC_BIN_SIZE;
+ } else {
+ ASSERT(thing_subtag(hdr) == HEAP_BINARY_SUBTAG);
+ sum += heap_bin_size(binary_size(obj) + extra_bytes);
+ }
+ goto pop_next;
+ }
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD : {
+ flatmap_t *mp = (flatmap_t*)flatmap_val(obj);
+ Uint n = flatmap_get_size(mp) + 1;
+ ptr = (Eterm *)mp;
+ sum += n + 2;
+ ptr += 2; /* hdr + size words */
+ while (n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP : {
+ Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ sum += 1 + n + header_arity(hdr);
+ ptr += 1 + header_arity(hdr);
+ while (n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ case BIN_MATCHSTATE_SUBTAG:
+ erl_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:
+ erl_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:
+ erl_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:
+ erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj);
+ }
+ }
+
+ all_clean:
+ /* Return the result */
+ DESTROY_EQUEUE(s);
+ DESTROY_BITSTORE(b);
+ return sum;
+}
+
+
+/*
* Copy a structure to a heap.
*/
-#if HALFWORD_HEAP
-Eterm copy_struct_rel(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap,
- Eterm* src_base, Eterm* dst_base)
-#else
-Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
-#endif
+Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint *bsz)
{
char* hstart;
Uint hsize;
@@ -247,19 +614,23 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
Eterm* argp;
Eterm* const_tuple;
Eterm hdr;
+ Eterm *hend;
int i;
#ifdef DEBUG
Eterm org_obj = obj;
Uint org_sz = sz;
+ Eterm mypid = erts_get_current_pid();
#endif
if (IS_CONST(obj))
return obj;
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_struct %p\n", mypid, obj));
+
DTRACE1(copy_struct, (int32_t)sz);
hp = htop = *hpp;
- hbot = htop + sz;
+ hbot = hend = htop + sz;
hstart = (char *)htop;
hsize = (char*) hbot - hstart;
const_tuple = 0;
@@ -268,7 +639,7 @@ 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:
@@ -286,14 +657,11 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
hp++;
break;
case TAG_PRIMARY_LIST:
- objp = list_val_rel(obj,src_base);
- #if !HALFWORD_HEAP || defined(DEBUG)
- if (in_area(objp,hstart,hsize)) {
- ASSERT(!HALFWORD_HEAP);
+ objp = list_val(obj);
+ if (ErtsInArea(objp,hstart,hsize)) {
hp++;
break;
}
- #endif
argp = hp++;
/* Fall through */
@@ -309,23 +677,15 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
else {
CAR(htop) = elem;
- #if HALFWORD_HEAP
- CDR(htop) = CDR(objp);
- *tailp = make_list_rel(htop,dst_base);
- htop += 2;
- goto L_copy;
- #else
tailp = &CDR(htop);
htop += 2;
- #endif
}
- ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot);
- *tp = make_list_rel(tailp - 1, dst_base);
+ *tp = make_list(tailp - 1);
obj = CDR(objp);
if (!is_list(obj)) {
break;
}
- objp = list_val_rel(obj,src_base);
+ objp = list_val(obj);
}
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy;
@@ -337,24 +697,21 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
case TAG_PRIMARY_BOXED:
- #if !HALFWORD_HEAP || defined(DEBUG)
- if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) {
- ASSERT(!HALFWORD_HEAP);
+ if (ErtsInArea(boxed_val(obj),hstart,hsize)) {
hp++;
break;
}
- #endif
argp = hp++;
L_copy_boxed:
- objp = boxed_val_rel(obj, src_base);
+ objp = boxed_val(obj);
hdr = *objp;
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
{
int const_flag = 1; /* assume constant tuple */
i = arityval(hdr);
- *argp = make_tuple_rel(htop, dst_base);
+ *argp = make_tuple(htop);
tp = htop; /* tp is pointer to new arity value */
*htop++ = *objp++; /* copy arity value */
while (i--) {
@@ -383,7 +740,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
while (i--) {
*tp++ = *objp++;
}
- *argp = make_binary_rel(hbot, dst_base);
+ *argp = make_binary(hbot);
pb = (ProcBin*) hbot;
erts_refc_inc(&pb->val->refc, 2);
pb->next = off_heap->first;
@@ -410,7 +767,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
extra_bytes = 0;
}
real_size = size+extra_bytes;
- objp = binary_val_rel(real_bin,src_base);
+ objp = binary_val(real_bin);
if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) {
ErlHeapBin* from = (ErlHeapBin *) objp;
ErlHeapBin* to;
@@ -440,7 +797,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
off_heap->first = (struct erl_off_heap_header*) to;
OH_OVERHEAD(off_heap, to->size / sizeof(Eterm));
}
- *argp = make_binary_rel(hbot, dst_base);
+ *argp = make_binary(hbot);
if (extra_bytes != 0) {
ErlSubBin* res;
hbot -= ERL_SUB_BIN_SIZE;
@@ -452,7 +809,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
res->offs = 0;
res->is_writable = 0;
res->orig = *argp;
- *argp = make_binary_rel(hbot, dst_base);
+ *argp = make_binary(hbot);
}
break;
}
@@ -470,7 +827,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
funp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) funp;
erts_refc_inc(&funp->fe->refc, 2);
- *argp = make_fun_rel(tp, dst_base);
+ *argp = make_fun(tp);
}
break;
case EXTERNAL_PID_SUBTAG:
@@ -490,7 +847,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
off_heap->first = (struct erl_off_heap_header*)etp;
erts_refc_inc(&etp->node->refc, 2);
- *argp = make_external_rel(tp, dst_base);
+ *argp = make_external(tp);
}
break;
case MAP_SUBTAG:
@@ -498,7 +855,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
switch (MAP_HEADER_TYPE(hdr)) {
case MAP_HEADER_TAG_FLATMAP_HEAD :
i = flatmap_get_size(objp) + 3;
- *argp = make_flatmap_rel(htop, dst_base);
+ *argp = make_flatmap(htop);
while (i--) {
*htop++ = *objp++;
}
@@ -509,7 +866,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
i = 1 + hashmap_bitcount(MAP_HEADER_VAL(hdr));
while (i--) { *htop++ = *objp++; }
- *argp = make_hashmap_rel(tp, dst_base);
+ *argp = make_hashmap(tp);
break;
default:
erl_exit(ERTS_ABORT_EXIT, "copy_struct: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
@@ -522,7 +879,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
i = thing_arityval(hdr)+1;
hbot -= i;
tp = hbot;
- *argp = make_boxed_rel(hbot, dst_base);
+ *argp = make_boxed(hbot);
while (i--) {
*tp++ = *objp++;
}
@@ -538,22 +895,870 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
}
+ if (bsz) {
+ *hpp = htop;
+ *bsz = hend - hbot;
+ } else {
#ifdef DEBUG
- if (htop != hbot)
- erl_exit(ERTS_ABORT_EXIT,
- "Internal error in copy_struct() when copying %T:"
- " htop=%p != hbot=%p (sz=%beu)\n",
- org_obj, htop, hbot, org_sz);
+ if (htop != hbot)
+ 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);
#else
- if (htop > hbot) {
- erl_exit(ERTS_ABORT_EXIT,
- "Internal error in copy_struct(): htop, hbot overrun\n");
- }
+ if (htop > hbot) {
+ erl_exit(ERTS_ABORT_EXIT,
+ "Internal error in copy_struct(): htop, hbot overrun\n");
+ }
#endif
- *hpp = (Eterm *) (hstart+hsize);
+ *hpp = (Eterm *) (hstart+hsize);
+ }
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, res));
return res;
}
+
+/*
+ * Machinery for the table used by the sharing preserving copier
+ * Using an ESTACK but not very transparently; consider refactoring
+ */
+
+#define DECLARE_SHTABLE(s) \
+ DECLARE_ESTACK(s); \
+ Uint ESTK_CONCAT(s,_offset) = 0
+#define DESTROY_SHTABLE(s) DESTROY_ESTACK(s)
+#define SHTABLE_INCR 4
+#define SHTABLE_NEXT(s) ESTK_CONCAT(s,_offset)
+#define SHTABLE_PUSH(s,x,y,b) \
+do { \
+ if (s.sp > s.end - SHTABLE_INCR) { \
+ erl_grow_estack(&(s), SHTABLE_INCR); \
+ } \
+ *s.sp++ = (x); \
+ *s.sp++ = (y); \
+ *s.sp++ = (Eterm) NULL; \
+ *s.sp++ = (Eterm) (b); \
+ ESTK_CONCAT(s,_offset) += SHTABLE_INCR; \
+} while(0)
+#define SHTABLE_X(s,e) (s.start[e])
+#define SHTABLE_Y(s,e) (s.start[(e)+1])
+#define SHTABLE_FWD(s,e) ((Eterm *) (s.start[(e)+2]))
+#define SHTABLE_FWD_UPD(s,e,p) (s.start[(e)+2] = (Eterm) (p))
+#define SHTABLE_REV(s,e) ((Eterm *) (s.start[(e)+3]))
+
+#define LIST_SHARED_UNPROCESSED ((Eterm) 0)
+#define LIST_SHARED_PROCESSED ((Eterm) 1)
+
+#define HEAP_ELEM_TO_BE_FILLED _unchecked_make_list(NULL)
+
+
+/*
+ * Specialized macros for using/reusing the persistent state
+ */
+
+#define DECLARE_EQUEUE_INIT_INFO(q, info) \
+ UWord* EQUE_DEF_QUEUE(q) = info->queue_default; \
+ ErtsEQueue q = { \
+ EQUE_DEF_QUEUE(q), /* start */ \
+ EQUE_DEF_QUEUE(q), /* front */ \
+ EQUE_DEF_QUEUE(q), /* back */ \
+ 1, /* possibly_empty */ \
+ EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }
+
+#define DECLARE_EQUEUE_FROM_INFO(q, info) \
+ /* no EQUE_DEF_QUEUE(q), read-only */ \
+ ErtsEQueue q = { \
+ info->queue_start, /* start */ \
+ info->queue_start, /* front */ \
+ info->queue_start, /* back */ \
+ 1, /* possibly_empty */ \
+ info->queue_end, /* end */ \
+ info->queue_alloc_type /* alloc_type */ \
+ }
+
+#define DECLARE_BITSTORE_INIT_INFO(s, info) \
+ UWord* WSTK_DEF_STACK(s) = info->bitstore_default; \
+ ErtsWStack s = { \
+ WSTK_DEF_STACK(s), /* wstart */ \
+ WSTK_DEF_STACK(s), /* wsp */ \
+ WSTK_DEF_STACK(s) + DEF_WSTACK_SIZE, /* wend */ \
+ WSTK_DEF_STACK(s), /* wdflt */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }; \
+ int WSTK_CONCAT(s,_bitoffs) = 0; \
+ /* no WSTK_CONCAT(s,_offset), write-only */ \
+ UWord WSTK_CONCAT(s,_buffer) = 0
+
+#define DECLARE_BITSTORE_FROM_INFO(s, info) \
+ /* no WSTK_DEF_STACK(s), read-only */ \
+ ErtsWStack s = { \
+ info->bitstore_start, /* wstart */ \
+ NULL, /* wsp, read-only */ \
+ NULL, /* wend, read-only */ \
+ NULL, /* wdef, read-only */ \
+ info->bitstore_alloc_type /* alloc_type */ \
+ }; \
+ int WSTK_CONCAT(s,_bitoffs) = 0; \
+ int WSTK_CONCAT(s,_offset) = 0; \
+ UWord WSTK_CONCAT(s,_buffer) = 0
+
+#define DECLARE_SHTABLE_INIT_INFO(s, info) \
+ Eterm* ESTK_DEF_STACK(s) = info->shtable_default; \
+ ErtsEStack s = { \
+ ESTK_DEF_STACK(s), /* start */ \
+ ESTK_DEF_STACK(s), /* sp */ \
+ ESTK_DEF_STACK(s) + DEF_ESTACK_SIZE, /* end */ \
+ ESTK_DEF_STACK(s), /* default */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }; \
+ Uint ESTK_CONCAT(s,_offset) = 0
+
+#define DECLARE_SHTABLE_FROM_INFO(s, info) \
+ /* no ESTK_DEF_STACK(s), read-only */ \
+ ErtsEStack s = { \
+ info->shtable_start, /* start */ \
+ NULL, /* sp, read-only */ \
+ NULL, /* end, read-only */ \
+ NULL, /* def, read-only */ \
+ info->shtable_alloc_type /* alloc_type */ \
+ }; \
+ /* no ESTK_CONCAT(s,_offset), read-only */
+
+/*
+ * Copy object "obj" preserving sharing.
+ * First half: count size and calculate sharing.
+ */
+Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info)
+{
+ Uint sum;
+ Uint e;
+ unsigned sz;
+ Eterm* ptr;
+#ifdef DEBUG
+ Eterm mypid = erts_get_current_pid();
+#endif
+
+ DECLARE_EQUEUE_INIT_INFO(s, info);
+ DECLARE_BITSTORE_INIT_INFO(b, info);
+ DECLARE_SHTABLE_INIT_INFO(t, info);
+
+ /* step #0:
+ -------------------------------------------------------
+ get rid of the easy cases first:
+ - copying constants
+ - if not a proper process, do flat copy
+ */
+
+ if (IS_CONST(obj))
+ return 0;
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_calculate %p\n", mypid, obj));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] message is %T\n", mypid, obj));
+
+ /* step #1:
+ -------------------------------------------------------
+ traverse the term and calculate the size;
+ when traversing, transform as you do in size_shared
+ but when you find shared objects:
+
+ a. add entry in the table, indexed by i
+ b. mark them:
+ b1. boxed terms, set header to (i | 11)
+ store (old header, NONV, NULL, backptr) in the entry
+ b2. cons cells, set CDR to NONV, set CAR to i
+ store (old CAR, old CDR, NULL, backptr) in the entry
+ */
+
+ sum = 0;
+
+ for (;;) {
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ ptr = list_val(obj);
+ /* off heap list pointers are copied verbatim */
+ if (erts_is_literal(obj,ptr)) {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj));
+ if (IN_LITERAL_PURGE_AREA(info,ptr))
+ info->literal_size += size_object(obj);
+ goto pop_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if it's visited, don't count it;
+ if not already shared, make it shared and store it in the table */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER ||
+ primary_tag(head) == TAG_PRIMARY_HEADER) {
+ if (tail != THE_NON_VALUE) {
+ e = SHTABLE_NEXT(t);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling L %p\n", mypid, ptr));
+ SHTABLE_PUSH(t, head, tail, ptr);
+ CAR(ptr) = (e << _TAG_PRIMARY_SIZE) | LIST_SHARED_UNPROCESSED;
+ CDR(ptr) = THE_NON_VALUE;
+ }
+ goto pop_next;
+ }
+ /* else make it visited now */
+ switch (primary_tag(tail)) {
+ case TAG_PRIMARY_LIST:
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/L %p\n", mypid, ptr));
+ CDR(ptr) = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER;
+ break;
+ case TAG_PRIMARY_IMMED1:
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/I %p\n", mypid, ptr));
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head);
+ break;
+ case TAG_PRIMARY_BOXED:
+ BITSTORE_PUT(b, primary_tag(head));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/B %p\n", mypid, ptr));
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER;
+ break;
+ }
+ /* and count it */
+ sum += 2;
+ if (!IS_CONST(head)) {
+ EQUEUE_PUT(s, head);
+ }
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ ptr = boxed_val(obj);
+ /* off heap pointers to boxes are copied verbatim */
+ if (erts_is_literal(obj,ptr)) {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj));
+ if (IN_LITERAL_PURGE_AREA(info,ptr))
+ info->literal_size += size_object(obj);
+ goto pop_next;
+ }
+ hdr = *ptr;
+ /* if it's visited, don't count it;
+ if not already shared, make it shared and store it in the table */
+ if (primary_tag(hdr) != TAG_PRIMARY_HEADER) {
+ if (primary_tag(hdr) == BOXED_VISITED) {
+ e = SHTABLE_NEXT(t);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling B %p\n", mypid, ptr));
+ SHTABLE_PUSH(t, hdr, THE_NON_VALUE, ptr);
+ *ptr = (e << _TAG_PRIMARY_SIZE) | BOXED_SHARED_UNPROCESSED;
+ }
+ goto pop_next;
+ }
+ /* else make it visited now */
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling B %p\n", mypid, ptr));
+ *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED;
+ /* and count it */
+ ASSERT(is_header(hdr));
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ sum += arity + 1;
+ if (arity == 0) { /* Empty tuple -- unusual. */
+ goto pop_next;
+ }
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ sz = thing_arityval(hdr);
+ sum += 1 /* header */ + sz + eterms;
+ ptr += 1 /* header */ + sz;
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case SUB_BINARY_SUBTAG: {
+ ErlSubBin* sb = (ErlSubBin *) ptr;
+ Eterm real_bin = sb->orig;
+ Uint bit_offset = sb->bitoffs;
+ Uint bit_size = sb->bitsize;
+ size_t size = sb->size;
+ Uint extra_bytes;
+ Eterm hdr;
+ if (bit_size + bit_offset > 8) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 2;
+ } else if (bit_size + bit_offset > 0) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 1;
+ } else {
+ extra_bytes = 0;
+ }
+ ASSERT(is_boxed(real_bin) &&
+ (((*boxed_val(real_bin)) &
+ (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK))
+ == _TAG_HEADER_REFC_BIN));
+ hdr = *_unchecked_binary_val(real_bin) & ~BOXED_VISITED_MASK;
+ if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) {
+ sum += heap_bin_size(size+extra_bytes);
+ } else {
+ ASSERT(thing_subtag(hdr) == REFC_BINARY_SUBTAG);
+ sum += PROC_BIN_SIZE;
+ }
+ goto pop_next;
+ }
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD : {
+ flatmap_t *mp = (flatmap_t *) ptr;
+ Uint n = flatmap_get_size(mp) + 1;
+ sum += n + 2;
+ ptr += 2; /* hdr + size words */
+ while (n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP : {
+ Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ sum += 1 + n + header_arity(hdr);
+ ptr += 1 + header_arity(hdr);
+
+ if (n == 0) {
+ goto pop_next;
+ }
+ while(n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "copy_shared_calculate: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ case BIN_MATCHSTATE_SUBTAG:
+ erl_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:
+ erl_exit(ERTS_ABORT_EXIT, "[pid=%T] size_shared: bad tag for %#x\n", obj);
+ }
+ }
+}
+
+/*
+ * Copy object "obj" preserving sharing.
+ * Second half: copy and restore the object.
+ */
+Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info,
+ Eterm** hpp, ErlOffHeap* off_heap) {
+ Uint e;
+ unsigned sz;
+ Eterm* ptr;
+ Eterm* hp;
+ Eterm* hscan;
+ Eterm result;
+ Eterm* resp;
+ Eterm *hbot, *hend;
+ unsigned remaining;
+#ifdef DEBUG
+ Eterm mypid = erts_get_current_pid();
+ Eterm saved_obj = obj;
+#endif
+
+ DECLARE_EQUEUE_FROM_INFO(s, info);
+ DECLARE_BITSTORE_FROM_INFO(b, info);
+ DECLARE_SHTABLE_FROM_INFO(t, info);
+
+ /* step #0:
+ -------------------------------------------------------
+ get rid of the easy cases first:
+ - copying constants
+ - if not a proper process, do flat copy
+ */
+
+ if (IS_CONST(obj))
+ return obj;
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_perform %p\n", mypid, obj));
+
+ /* step #2: was performed before this function was called
+ -------------------------------------------------------
+ allocate new space
+ */
+
+ hscan = hp = *hpp;
+ hbot = hend = hp + size;
+
+ /* step #3:
+ -------------------------------------------------------
+ traverse the term a second time and when traversing:
+ a. if the object is marked as shared
+ a1. if the entry contains a forwarding ptr, use that
+ a2. otherwise, copy it to the new space and store the
+ forwarding ptr to the entry
+ b. otherwise, reverse-transform as you do in size_shared
+ and copy to the new space
+ */
+
+ resp = &result;
+ remaining = 0;
+ for (;;) {
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ ptr = list_val(obj);
+ /* off heap list pointers are copied verbatim */
+ if (erts_is_literal(obj,ptr)) {
+ if (!IN_LITERAL_PURGE_AREA(info,ptr)) {
+ *resp = obj;
+ } else {
+ Uint bsz = 0;
+ *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz);
+ hbot -= bsz;
+ }
+ goto cleanup_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if it is shared */
+ if (tail == THE_NON_VALUE) {
+ e = head >> _TAG_PRIMARY_SIZE;
+ /* if it has been processed, just use the forwarding pointer */
+ if (primary_tag(head) == LIST_SHARED_PROCESSED) {
+ *resp = make_list(SHTABLE_FWD(t, e));
+ goto cleanup_next;
+ }
+ /* else, let's process it now,
+ copy it and keep the forwarding pointer */
+ else {
+ CAR(ptr) = (head - primary_tag(head)) + LIST_SHARED_PROCESSED;
+ head = SHTABLE_X(t, e);
+ tail = SHTABLE_Y(t, e);
+ ptr = &(SHTABLE_X(t, e));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled L %p is %p\n", mypid, ptr, SHTABLE_REV(t, e)));
+ SHTABLE_FWD_UPD(t, e, hp);
+ }
+ }
+ /* if not already clean, clean it up and copy it */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER) {
+ if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ Eterm saved;
+ BITSTORE_FETCH(b, saved);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", mypid, ptr));
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved;
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED;
+ } else {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/L %p\n", mypid, ptr));
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST;
+ }
+ } else if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/I %p\n", mypid, ptr));
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail);
+ CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1;
+ } else {
+ ASSERT(0 && "cannot come here");
+ goto cleanup_next;
+ }
+ /* and its children too */
+ if (IS_CONST(head)) {
+ CAR(hp) = head;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, head);
+ CAR(hp) = HEAP_ELEM_TO_BE_FILLED;
+ }
+ *resp = make_list(hp);
+ resp = &(CDR(hp));
+ hp += 2;
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ ptr = boxed_val(obj);
+ /* off heap pointers to boxes are copied verbatim */
+ if (erts_is_literal(obj,ptr)) {
+ if (!IN_LITERAL_PURGE_AREA(info,ptr)) {
+ *resp = obj;
+ } else {
+ Uint bsz = 0;
+ *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz);
+ hbot -= bsz;
+ }
+ goto cleanup_next;
+ }
+ hdr = *ptr;
+ /* clean it up, unless it's already clean or shared and processed */
+ switch (primary_tag(hdr)) {
+ case TAG_PRIMARY_HEADER:
+ ASSERT(0 && "cannot come here");
+ /* if it is shared and has been processed,
+ just use the forwarding pointer */
+ case BOXED_SHARED_PROCESSED:
+ e = hdr >> _TAG_PRIMARY_SIZE;
+ *resp = make_boxed(SHTABLE_FWD(t, e));
+ goto cleanup_next;
+ /* if it is shared but has not been processed yet, let's process
+ it now: copy it and keep the forwarding pointer */
+ case BOXED_SHARED_UNPROCESSED:
+ e = hdr >> _TAG_PRIMARY_SIZE;
+ *ptr = (hdr - primary_tag(hdr)) + BOXED_SHARED_PROCESSED;
+ hdr = SHTABLE_X(t, e);
+ ASSERT(primary_tag(hdr) == BOXED_VISITED);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled B %p is %p\n", mypid, ptr, SHTABLE_REV(t, e)));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr));
+ SHTABLE_X(t, e) = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
+ SHTABLE_FWD_UPD(t, e, hp);
+ break;
+ case BOXED_VISITED:
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr));
+ *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
+ break;
+ }
+ /* and its children too */
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ *resp = make_boxed(hp);
+ *hp++ = hdr;
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ goto cleanup_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ sz = thing_arityval(hdr);
+ funp = (ErlFunThing *) hp;
+ *resp = make_fun(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ funp->next = off_heap->first;
+ off_heap->first = (struct erl_off_heap_header*) funp;
+ erts_refc_inc(&funp->fe->refc, 2);
+ goto cleanup_next;
+ }
+ case MAP_SUBTAG:
+ *resp = make_flatmap(hp);
+ *hp++ = hdr;
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD : {
+ flatmap_t *mp = (flatmap_t *) ptr;
+ Uint n = flatmap_get_size(mp) + 1;
+ *hp++ = *++ptr; /* keys */
+ while (n--) {
+ obj = *++ptr;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ goto cleanup_next;
+ }
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ *hp++ = *++ptr; /* total map size */
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP : {
+ Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ while (n--) {
+ obj = *++ptr;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ goto cleanup_next;
+ }
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "copy_shared_perform: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ case REFC_BINARY_SUBTAG: {
+ ProcBin* pb = (ProcBin *) ptr;
+ sz = thing_arityval(hdr);
+ if (pb->flags) {
+ erts_emasculate_writable_binary(pb);
+ }
+ pb = (ProcBin *) hp;
+ *resp = make_binary(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ erts_refc_inc(&pb->val->refc, 2);
+ pb->next = off_heap->first;
+ pb->flags = 0;
+ off_heap->first = (struct erl_off_heap_header*) pb;
+ OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm));
+ goto cleanup_next;
+ }
+ case SUB_BINARY_SUBTAG: {
+ ErlSubBin* sb = (ErlSubBin *) ptr;
+ Eterm real_bin = sb->orig;
+ Uint bit_offset = sb->bitoffs;
+ Uint bit_size = sb->bitsize;
+ Uint offset = sb->offs;
+ size_t size = sb->size;
+ Uint extra_bytes;
+ Uint real_size;
+ if ((bit_size + bit_offset) > 8) {
+ extra_bytes = 2;
+ } else if ((bit_size + bit_offset) > 0) {
+ extra_bytes = 1;
+ } else {
+ extra_bytes = 0;
+ }
+ real_size = size+extra_bytes;
+ ASSERT(is_boxed(real_bin) &&
+ (((*boxed_val(real_bin)) &
+ (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK))
+ == _TAG_HEADER_REFC_BIN));
+ ptr = _unchecked_binary_val(real_bin);
+ *resp = make_binary(hp);
+ if (extra_bytes != 0) {
+ ErlSubBin* res = (ErlSubBin *) hp;
+ hp += ERL_SUB_BIN_SIZE;
+ res->thing_word = HEADER_SUB_BIN;
+ res->size = size;
+ res->bitsize = bit_size;
+ res->bitoffs = bit_offset;
+ res->offs = 0;
+ res->is_writable = 0;
+ res->orig = make_binary(hp);
+ }
+ if (thing_subtag(*ptr & ~BOXED_VISITED_MASK) == HEAP_BINARY_SUBTAG) {
+ ErlHeapBin* from = (ErlHeapBin *) ptr;
+ ErlHeapBin* to = (ErlHeapBin *) hp;
+ hp += heap_bin_size(real_size);
+ to->thing_word = header_heap_bin(real_size);
+ to->size = real_size;
+ sys_memcpy(to->data, ((byte *)from->data)+offset, real_size);
+ } else {
+ ProcBin* from = (ProcBin *) ptr;
+ ProcBin* to = (ProcBin *) hp;
+ ASSERT(thing_subtag(*ptr & ~BOXED_VISITED_MASK) == REFC_BINARY_SUBTAG);
+ if (from->flags) {
+ erts_emasculate_writable_binary(from);
+ }
+ hp += PROC_BIN_SIZE;
+ to->thing_word = HEADER_PROC_BIN;
+ to->size = real_size;
+ to->val = from->val;
+ erts_refc_inc(&to->val->refc, 2);
+ to->bytes = from->bytes + offset;
+ to->next = off_heap->first;
+ to->flags = 0;
+ off_heap->first = (struct erl_off_heap_header*) to;
+ OH_OVERHEAD(off_heap, to->size / sizeof(Eterm));
+ }
+ goto cleanup_next;
+ }
+ case EXTERNAL_PID_SUBTAG:
+ case EXTERNAL_PORT_SUBTAG:
+ case EXTERNAL_REF_SUBTAG: {
+ ExternalThing *etp = (ExternalThing *) hp;
+ sz = thing_arityval(hdr);
+ *resp = make_external(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ etp->next = off_heap->first;
+ off_heap->first = (struct erl_off_heap_header*) etp;
+ erts_refc_inc(&etp->node->refc, 2);
+ goto cleanup_next;
+ }
+ default:
+ sz = thing_arityval(hdr);
+ *resp = make_boxed(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ goto cleanup_next;
+ }
+ break;
+ }
+ case TAG_PRIMARY_IMMED1:
+ *resp = obj;
+ cleanup_next:
+ if (EQUEUE_ISEMPTY(s)) {
+ goto all_clean;
+ }
+ obj = EQUEUE_GET(s);
+ for (;;) {
+ ASSERT(hscan < hp);
+ if (remaining == 0) {
+ if (*hscan == HEAP_ELEM_TO_BE_FILLED) {
+ resp = hscan;
+ hscan += 2;
+ break; /* scanning loop */
+ } else if (primary_tag(*hscan) == TAG_PRIMARY_HEADER) {
+ switch (*hscan & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG:
+ remaining = header_arity(*hscan);
+ hscan++;
+ break;
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) hscan;
+ hscan += 1 + thing_arityval(*hscan);
+ remaining = 1 + funp->num_free;
+ break;
+ }
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(*hscan)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD : {
+ flatmap_t *mp = (flatmap_t *) hscan;
+ remaining = flatmap_get_size(mp) + 1;
+ hscan += 2;
+ break;
+ }
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
+ remaining = hashmap_bitcount(MAP_HEADER_VAL(*hscan));
+ hscan += MAP_HEADER_ARITY(*hscan) + 1;
+ break;
+ default:
+ erl_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:
+ erl_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);
+ erl_exit(ERTS_ABORT_EXIT, "copy (shared) not equal to source\n");
+ }
+#endif
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] original was %T\n", mypid, saved_obj));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy is %T\n", mypid, result));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, result));
+
+ ASSERT(hbot == hp);
+ ASSERT(size == ((hp - *hpp) + (hend - hbot)));
+ *hpp = hend;
+ return result;
+}
+
+
/*
* Copy a term that is guaranteed to be contained in a single
* heap block. The heap block is copied word by word, and any
@@ -563,21 +1768,12 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
*
* NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr).
*/
-#if HALFWORD_HEAP
-Eterm copy_shallow_rel(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap,
- Eterm* src_base)
-#else
Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
-#endif
{
Eterm* tp = ptr;
Eterm* hp = *hpp;
const Eterm res = make_tuple(hp);
-#if HALFWORD_HEAP
- const Sint offs = COMPRESS_POINTER(hp - (tp - src_base));
-#else
const Sint offs = (hp - tp) * sizeof(Eterm);
-#endif
while (sz--) {
Eterm val = *tp++;
@@ -652,17 +1848,24 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
* move markers.
* Typically used to copy a multi-fragmented message (from NIF).
*/
-void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
- Eterm* refs, unsigned nrefs)
+void erts_move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
+ Eterm* refs, unsigned nrefs, int literals)
{
ErlHeapFragment* bp;
Eterm* hp_start = *hpp;
Eterm* hp_end;
Eterm* hp;
unsigned i;
+ Eterm literal_tag;
+
+#ifdef TAG_LITERAL_PTR
+ literal_tag = (Eterm) literals ? TAG_LITERAL_PTR : 0;
+#else
+ literal_tag = (Eterm) 0;
+#endif
for (bp=first; bp!=NULL; bp=bp->next) {
- move_one_frag(hpp, bp, off_heap);
+ move_one_frag(hpp, bp, off_heap, literals);
}
hp_end = *hpp;
for (hp=hp_start; hp<hp_end; ++hp) {
@@ -675,6 +1878,9 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
val = *ptr;
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
+#ifdef TAG_LITERAL_PTR
+ val |= literal_tag;
+#endif
*hp = val;
}
break;
@@ -682,7 +1888,11 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
ptr = list_val(gval);
val = *ptr;
if (IS_MOVED_CONS(val)) {
- *hp = ptr[1];
+ val = ptr[1];
+#ifdef TAG_LITERAL_PTR
+ val |= literal_tag;
+#endif
+ *hp = val;
}
break;
case TAG_PRIMARY_HEADER:
@@ -693,12 +1903,12 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
}
}
for (i=0; i<nrefs; ++i) {
- refs[i] = follow_moved(refs[i]);
+ refs[i] = follow_moved(refs[i], literal_tag);
}
}
static void
-move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap)
+move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int literals)
{
Eterm* ptr = frag->mem;
Eterm* end = ptr + frag->used_size;
@@ -735,4 +1945,3 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap)
OH_OVERHEAD(off_heap, frag->off_heap.overhead);
frag->off_heap.first = NULL;
}
-
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 7be2b77a3b..e31ef29562 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -378,10 +378,11 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp)
ASSERT(lnk->type == LINK_NODE);
if (is_internal_pid(lnk->pid)) {
ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
- rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks);
- if (!rp) {
+ ErlOffHeap *ohp;
+ rp = erts_proc_lookup(lnk->pid);
+ if (!rp)
goto done;
- }
+ erts_smp_proc_lock(rp, rp_locks);
rlnk = erts_remove_link(&ERTS_P_LINKS(rp), name);
if (rlnk != NULL) {
ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE));
@@ -389,12 +390,14 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp)
}
n = ERTS_LINK_REFC(lnk);
for (i = 0; i < n; ++i) {
- ErlHeapFragment* bp;
- ErlOffHeap *ohp;
Eterm tup;
- Eterm *hp = erts_alloc_message_heap(3,&bp,&ohp,rp,&rp_locks);
+ Eterm *hp;
+ ErtsMessage *msgp;
+
+ msgp = erts_alloc_message_heap(rp, &rp_locks,
+ 3, &hp, &ohp);
tup = TUPLE2(hp, am_nodedown, name);
- erts_queue_message(rp, &rp_locks, bp, tup, NIL);
+ erts_queue_message(rp, &rp_locks, msgp, tup, NIL);
}
erts_smp_proc_unlock(rp, rp_locks);
}
@@ -737,19 +740,11 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx)
Binary* ctx_bin = erts_create_magic_binary(sizeof(struct exported_ctx),
erts_dsend_context_dtor);
struct exported_ctx* dst = ERTS_MAGIC_BIN_DATA(ctx_bin);
- Uint ctl_size = !HALFWORD_HEAP ? 0 : (arityval(ctx->ctl_heap[0]) + 1);
- Eterm* hp = HAlloc(p, ctl_size + PROC_BIN_SIZE);
+ Eterm* hp = HAlloc(p, PROC_BIN_SIZE);
sys_memcpy(&dst->ctx, ctx, sizeof(ErtsSendContext));
ASSERT(ctx->dss.ctl == make_tuple(ctx->ctl_heap));
-#if !HALFWORD_HEAP
dst->ctx.dss.ctl = make_tuple(dst->ctx.ctl_heap);
-#else
- /* Must put control tuple in low mem */
- sys_memcpy(hp, ctx->ctl_heap, ctl_size*sizeof(Eterm));
- dst->ctx.dss.ctl = make_tuple(hp);
- hp += ctl_size;
-#endif
if (ctx->dss.acmp) {
sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap));
dst->ctx.dss.acmp = &dst->acm;
@@ -886,11 +881,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
DTRACE_CHARBUF(receiver_name, 64);
#endif
- if (SEQ_TRACE_TOKEN(sender) != NIL
-#ifdef USE_VM_PROBES
- && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag
-#endif
- ) {
+ if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) {
seq_trace_update_send(sender);
token = SEQ_TRACE_TOKEN(sender);
seq_trace_output(token, message, SEQ_TRACE_SEND, remote, sender);
@@ -905,7 +896,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)),
"%T", remote);
msize = size_object(message);
- if (token != NIL && token != am_have_dt_utag) {
+ if (have_seqtrace(token)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
@@ -947,11 +938,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message,
DTRACE_CHARBUF(receiver_name, 128);
#endif
- if (SEQ_TRACE_TOKEN(sender) != NIL
-#ifdef USE_VM_PROBES
- && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag
-#endif
- ) {
+ if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) {
seq_trace_update_send(sender);
token = SEQ_TRACE_TOKEN(sender);
seq_trace_output(token, message, SEQ_TRACE_SEND, remote_name, sender);
@@ -966,7 +953,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message,
erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)),
"{%T,%s}", remote_name, node_name);
msize = size_object(message);
- if (token != NIL && token != am_have_dt_utag) {
+ if (have_seqtrace(token)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
@@ -1011,11 +998,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
#endif
UseTmpHeapNoproc(6);
- if (token != NIL
-#ifdef USE_VM_PROBES
- && token != am_have_dt_utag
-#endif
- ) {
+ if (have_seqtrace(token)) {
seq_trace_update_send(dsdp->proc);
seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local);
ctl = TUPLE5(&ctl_heap[0],
@@ -1034,7 +1017,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
"{%T,%s}", remote, node_name);
erts_snprintf(reason_str, sizeof(DTRACE_CHARBUF_NAME(reason_str)),
"%T", reason);
- if (token != NIL && token != am_have_dt_utag) {
+ if (have_seqtrace(token)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
@@ -1466,7 +1449,7 @@ int erts_net_message(Port *prt,
ErlOffHeap *ohp;
ASSERT(xsize);
heap_frag = erts_dist_ext_trailer(ede_copy);
- ERTS_INIT_HEAP_FRAG(heap_frag, token_size);
+ ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size);
hp = heap_frag->mem;
ohp = &heap_frag->off_heap;
token = tuple[5];
@@ -1515,7 +1498,7 @@ int erts_net_message(Port *prt,
ErlOffHeap *ohp;
ASSERT(xsize);
heap_frag = erts_dist_ext_trailer(ede_copy);
- ERTS_INIT_HEAP_FRAG(heap_frag, token_size);
+ ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size);
hp = heap_frag->mem;
ohp = &heap_frag->off_heap;
token = tuple[4];
@@ -2062,9 +2045,9 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
}
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define ERTS_PORT_REDS_MASK__ 0x003fffffffffffffL
-#elif defined(ARCH_32) || HALFWORD_HEAP
+#elif defined(ARCH_32)
#define ERTS_PORT_REDS_MASK__ 0x003fffff
#else
# error "Ohh come on ... !?!"
@@ -3275,11 +3258,16 @@ send_nodes_mon_msg(Process *rp,
Uint sz)
{
Eterm msg;
- ErlHeapFragment* bp;
+ Eterm *hp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
- Eterm *hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, rp_locksp);
#ifdef DEBUG
- Eterm *hend = hp + sz;
+ Eterm *hend;
+#endif
+
+ mp = erts_alloc_message_heap(rp, rp_locksp, sz, &hp, &ohp);
+#ifdef DEBUG
+ hend = hp + sz;
#endif
if (!nmp->opts) {
@@ -3325,7 +3313,7 @@ send_nodes_mon_msg(Process *rp,
}
ASSERT(hend == hp);
- erts_queue_message(rp, rp_locksp, bp, msg, NIL);
+ erts_queue_message(rp, rp_locksp, mp, msg, NIL);
}
static void
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 2a97069ac2..806f569c38 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -103,9 +103,9 @@ static Uint install_debug_functions(void);
static int lock_all_physical_memory = 0;
-ErtsAllocatorFunctions_t erts_allctrs[ERTS_ALC_A_MAX+1];
+ErtsAllocatorFunctions_t ERTS_WRITE_UNLIKELY(erts_allctrs[ERTS_ALC_A_MAX+1]);
ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1];
-ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1];
+ErtsAllocatorThrSpec_t ERTS_WRITE_UNLIKELY(erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]);
#define ERTS_MIN(A, B) ((A) < (B) ? (A) : (B))
#define ERTS_MAX(A, B) ((A) > (B) ? (A) : (B))
@@ -123,10 +123,6 @@ typedef union {
static ErtsAllocatorState_t std_alloc_state;
static ErtsAllocatorState_t ll_alloc_state;
-#if HALFWORD_HEAP
-static ErtsAllocatorState_t std_low_alloc_state;
-static ErtsAllocatorState_t ll_low_alloc_state;
-#endif
static ErtsAllocatorState_t sl_alloc_state;
static ErtsAllocatorState_t temp_alloc_state;
static ErtsAllocatorState_t eheap_alloc_state;
@@ -134,6 +130,7 @@ static ErtsAllocatorState_t binary_alloc_state;
static ErtsAllocatorState_t ets_alloc_state;
static ErtsAllocatorState_t driver_alloc_state;
static ErtsAllocatorState_t fix_alloc_state;
+static ErtsAllocatorState_t literal_alloc_state;
static ErtsAllocatorState_t test_alloc_state;
typedef struct {
@@ -151,24 +148,10 @@ typedef struct {
#define ERTS_ALC_INFO_A_MSEG_ALLOC (ERTS_ALC_A_MAX + 2)
#define ERTS_ALC_INFO_A_MAX ERTS_ALC_INFO_A_MSEG_ALLOC
-#if !HALFWORD_HEAP
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(aireq,
- ErtsAllocInfoReq,
- 5,
- ERTS_ALC_T_AINFO_REQ)
-#else
-static ERTS_INLINE ErtsAllocInfoReq *
-aireq_alloc(void)
-{
- return erts_alloc(ERTS_ALC_T_AINFO_REQ, sizeof(ErtsAllocInfoReq));
-}
-
-static ERTS_INLINE void
-aireq_free(ErtsAllocInfoReq *ptr)
-{
- erts_free(ERTS_ALC_T_AINFO_REQ, ptr);
-}
-#endif
+ ErtsAllocInfoReq,
+ 5,
+ ERTS_ALC_T_AINFO_REQ)
ErtsAlcType_t erts_fix_core_allocator_ix;
@@ -230,10 +213,7 @@ typedef struct {
struct au_init ets_alloc;
struct au_init driver_alloc;
struct au_init fix_alloc;
-#if HALFWORD_HEAP
- struct au_init std_low_alloc;
- struct au_init ll_low_alloc;
-#endif
+ struct au_init literal_alloc;
struct au_init test_alloc;
} erts_alc_hndl_args_init_t;
@@ -261,10 +241,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;
}
@@ -300,9 +276,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;
@@ -313,6 +289,51 @@ 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->atype = BESTFIT;
+ ip->init.bf.ao = 1;
+ ip->init.util.ramv = 0;
+ ip->init.util.mmsbc = 0;
+ ip->init.util.sbct = ~((UWord) 0);
+ ip->init.util.name_prefix = "literal_";
+ ip->init.util.alloc_no = ERTS_ALC_A_LITERAL;
+#ifndef SMALL_MEMORY
+ ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */
+#else
+ ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */
+#endif
+ ip->init.util.ts = ERTS_ALC_MTA_LITERAL;
+ ip->init.util.asbcst = 0;
+ ip->init.util.rsbcst = 0;
+ ip->init.util.rsbcmt = 0;
+ ip->init.util.rmbcmt = 0;
+ ip->init.util.acul = 0;
+
+#if defined(ARCH_32)
+# if HAVE_ERTS_MSEG
+ ip->init.util.mseg_alloc = &erts_alcu_literal_32_mseg_alloc;
+ ip->init.util.mseg_realloc = &erts_alcu_literal_32_mseg_realloc;
+ ip->init.util.mseg_dealloc = &erts_alcu_literal_32_mseg_dealloc;
+# endif
+ ip->init.util.sys_alloc = &erts_alcu_literal_32_sys_alloc;
+ ip->init.util.sys_realloc = &erts_alcu_literal_32_sys_realloc;
+ ip->init.util.sys_dealloc = &erts_alcu_literal_32_sys_dealloc;
+#elif defined(ARCH_64)
+# ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
+ ip->init.util.mseg_alloc = &erts_alcu_literal_64_mseg_alloc;
+ ip->init.util.mseg_realloc = &erts_alcu_literal_64_mseg_realloc;
+ ip->init.util.mseg_dealloc = &erts_alcu_literal_64_mseg_dealloc;
+# endif
+#else
+# error Unknown architecture
+#endif
+}
+
+static void
set_default_temp_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
@@ -330,10 +351,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
@@ -352,10 +369,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;
}
@@ -589,18 +602,16 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_PROC)]
= sizeof(Process);
-#if !HALFWORD_HEAP
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MONITOR_SH)]
= ERTS_MONITOR_SH_SIZE * sizeof(Uint);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NLINK_SH)]
= ERTS_LINK_SH_SIZE * sizeof(Uint);
-#endif
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_EV_D_STATE)]
= sizeof(ErtsDrvEventDataState);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_SEL_D_STATE)]
= sizeof(ErtsDrvSelectDataState);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MSG_REF)]
- = sizeof(ErlMessage);
+ = sizeof(ErtsMessageRef);
#ifdef ERTS_SMP
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_THR_Q_EL_SL)]
= sizeof(ErtsThrQElement_t);
@@ -642,6 +653,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
set_default_driver_alloc_opts(&init.driver_alloc);
set_default_fix_alloc_opts(&init.fix_alloc,
fix_type_sizes);
+ set_default_literal_alloc_opts(&init.literal_alloc);
set_default_test_alloc_opts(&init.test_alloc);
if (argc && argv)
@@ -670,6 +682,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.ets_alloc.thr_spec = 0;
init.driver_alloc.thr_spec = 0;
init.fix_alloc.thr_spec = 0;
+ init.literal_alloc.thr_spec = 0;
#endif
/* Make adjustments for carrier migration support */
@@ -682,6 +695,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
adjust_carrier_migration_support(&init.ets_alloc);
adjust_carrier_migration_support(&init.driver_alloc);
adjust_carrier_migration_support(&init.fix_alloc);
+ adjust_carrier_migration_support(&init.literal_alloc);
if (init.erts_alloc_config) {
/* Adjust flags that erts_alloc_config won't like */
@@ -696,6 +710,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.ets_alloc.thr_spec = 0;
init.driver_alloc.thr_spec = 0;
init.fix_alloc.thr_spec = 0;
+ init.literal_alloc.thr_spec = 0;
/* No carrier migration */
init.temp_alloc.init.util.acul = 0;
@@ -707,6 +722,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.ets_alloc.init.util.acul = 0;
init.driver_alloc.init.util.acul = 0;
init.fix_alloc.init.util.acul = 0;
+ init.literal_alloc.init.util.acul = 0;
}
#ifdef ERTS_SMP
@@ -723,6 +739,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
adjust_tpref(&init.ets_alloc, erts_no_schedulers);
adjust_tpref(&init.driver_alloc, erts_no_schedulers);
adjust_tpref(&init.fix_alloc, erts_no_schedulers);
+ adjust_tpref(&init.literal_alloc, erts_no_schedulers);
#else
/* No thread specific if not smp */
@@ -741,6 +758,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
refuse_af_strategy(&init.ets_alloc);
refuse_af_strategy(&init.driver_alloc);
refuse_af_strategy(&init.fix_alloc);
+ refuse_af_strategy(&init.literal_alloc);
#ifdef ERTS_SMP
if (!init.temp_alloc.thr_spec)
@@ -751,6 +769,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
#if HAVE_ERTS_MSEG
init.mseg.nos = erts_no_schedulers;
erts_mseg_init(&init.mseg);
+# if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ erts_mmap_init(&erts_literal_mmapper, &init.mseg.literal_mmap);
+# endif
#endif
erts_alcu_init(&init.alloc_util);
@@ -775,24 +796,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);
@@ -802,6 +805,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
set_au_allocator(ERTS_ALC_A_ETS, &init.ets_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_LITERAL, &init.literal_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_TEST, &init.test_alloc, ncpu);
for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
@@ -836,14 +840,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);
@@ -863,6 +859,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
start_au_allocator(ERTS_ALC_A_FIXED_SIZE,
&init.fix_alloc,
&fix_alloc_state);
+ start_au_allocator(ERTS_ALC_A_LITERAL,
+ &init.literal_alloc,
+ &literal_alloc_state);
start_au_allocator(ERTS_ALC_A_TEST,
&init.test_alloc,
@@ -871,9 +870,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
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();
@@ -971,6 +968,10 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu)
else
#endif
{
+#ifdef ERTS_SMP
+ erl_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;
@@ -979,6 +980,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;
@@ -1051,7 +1053,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)
@@ -1088,22 +1090,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;
@@ -1273,9 +1275,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;
@@ -1509,25 +1508,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);
}
@@ -1996,48 +1995,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)
{
@@ -2067,9 +2024,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;
@@ -2082,9 +2036,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)];
@@ -2143,11 +2094,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);
@@ -2241,15 +2187,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;
@@ -2330,11 +2267,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
}
}
}
@@ -2361,7 +2293,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,
@@ -2371,7 +2302,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
&size.processes_used,
fi,
ERTS_ALC_T_NLINK_SH);
-#endif
add_fix_values(&size.processes,
&size.processes_used,
fi,
@@ -2810,7 +2740,7 @@ erts_allocator_info(int to, void *arg)
erts_mseg_info(i, &to, arg, 0, NULL, NULL);
}
erts_print(to, arg, "=allocator:mseg_alloc.erts_mmap\n");
- erts_mmap_info(&to, arg, NULL, NULL, &emis);
+ erts_mmap_info(&erts_dflt_mmapper, &to, arg, NULL, NULL, &emis);
}
#endif
@@ -3036,12 +2966,12 @@ reply_alloc_info(void *vair)
int global_instances = air->req_sched == sched_id;
ErtsProcLocks rp_locks;
Process *rp = air->proc;
- Eterm ref_copy = NIL, ai_list, msg;
- Eterm *hp = NULL, *hp_end = NULL, *hp_start = NULL;
+ Eterm ref_copy = NIL, ai_list, msg = NIL;
+ Eterm *hp = NULL, *hp_start = NULL, *hp_end = NULL;
Eterm **hpp;
Uint sz, *szp;
ErlOffHeap *ohp = NULL;
- ErlHeapFragment *bp = NULL;
+ ErtsMessage *mp = NULL;
struct erts_mmap_info_struct emis;
int i;
Eterm (*info_func)(Allctr_t *,
@@ -3162,7 +3092,8 @@ reply_alloc_info(void *vair)
ai_list = erts_bld_cons(hpp, szp,
ainfo, ai_list);
- ainfo = (air->only_sz ? NIL : erts_mmap_info(NULL, NULL, hpp, szp, &emis));
+ ainfo = (air->only_sz ? NIL :
+ erts_mmap_info(&erts_dflt_mmapper, NULL, NULL, hpp, szp, &emis));
ainfo = erts_bld_tuple3(hpp, szp,
alloc_atom,
erts_bld_atom(hpp,szp,"erts_mmap"),
@@ -3242,20 +3173,17 @@ reply_alloc_info(void *vair)
if (hpp)
break;
- hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
hp_start = hp;
hp_end = hp + sz;
szp = NULL;
hpp = &hp;
}
- if (bp)
- bp = erts_resize_message_buffer(bp, hp - hp_start, &msg, 1);
- else {
- ASSERT(hp);
- HRelease(rp, hp_end, hp);
- }
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ if (hp != hp_end)
+ erts_shrink_message_heap(&mp, rp, hp_start, hp, hp_end, &msg, 1);
+
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (air->req_sched == sched_id)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -3479,8 +3407,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;
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index f540bae20d..71e4713624 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -30,6 +30,7 @@
#ifdef USE_THREADS
#include "erl_threads.h"
#endif
+#include "erl_mmap.h"
#ifdef DEBUG
# undef ERTS_ALC_WANT_INLINE
@@ -43,9 +44,11 @@
#if ERTS_CAN_INLINE && ERTS_ALC_WANT_INLINE
# define ERTS_ALC_DO_INLINE 1
# define ERTS_ALC_INLINE static ERTS_INLINE
+# define ERTS_ALC_FORCE_INLINE static ERTS_FORCE_INLINE
#else
# define ERTS_ALC_DO_INLINE 0
# define ERTS_ALC_INLINE
+# define ERTS_ALC_FORCE_INLINE
#endif
#define ERTS_ALC_NO_FIXED_SIZES \
@@ -177,6 +180,12 @@ void sys_free(void *) __deprecated; /* erts_free() */
void *sys_alloc(Uint ) __deprecated; /* erts_alloc_fnf() */
void *sys_realloc(void *, Uint) __deprecated; /* erts_realloc_fnf() */
+#undef ERTS_HAVE_IS_IN_LITERAL_RANGE
+#if defined(ARCH_32) || defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+# define ERTS_HAVE_IS_IN_LITERAL_RANGE
+#endif
+
+
/*
* erts_alloc[_fnf](), erts_realloc[_fnf](), erts_free() works as
* malloc(), realloc(), and free() with the following exceptions:
@@ -204,6 +213,9 @@ void erts_free(ErtsAlcType_t type, void *ptr);
void *erts_alloc_fnf(ErtsAlcType_t type, Uint size);
void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size);
int erts_is_allctr_wrapper_prelocked(void);
+#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
+int erts_is_in_literal_range(void* ptr);
+#endif
#endif /* #if !ERTS_ALC_DO_INLINE */
@@ -221,12 +233,14 @@ ERTS_ALC_INLINE
void *erts_alloc(ErtsAlcType_t type, Uint size)
{
void *res;
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
size);
if (!res)
erts_alloc_n_enomem(ERTS_ALC_T2N(type), size);
+ ERTS_MSACC_POP_STATE_X();
return res;
}
@@ -234,6 +248,7 @@ ERTS_ALC_INLINE
void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size)
{
void *res;
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
@@ -241,37 +256,48 @@ void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size)
size);
if (!res)
erts_realloc_n_enomem(ERTS_ALC_T2N(type), ptr, size);
+ ERTS_MSACC_POP_STATE_X();
return res;
}
ERTS_ALC_INLINE
void erts_free(ErtsAlcType_t type, void *ptr)
{
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
(*erts_allctrs[ERTS_ALC_T2A(type)].free)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
ptr);
+ ERTS_MSACC_POP_STATE_X();
}
ERTS_ALC_INLINE
void *erts_alloc_fnf(ErtsAlcType_t type, Uint size)
{
- return (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)(
+ void *res;
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
+ res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
size);
+ ERTS_MSACC_POP_STATE_X();
+ return res;
}
ERTS_ALC_INLINE
void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size)
{
- return (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)(
+ void *res;
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
+ res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
ptr,
size);
+ ERTS_MSACC_POP_STATE_X();
+ return res;
}
ERTS_ALC_INLINE
@@ -281,6 +307,28 @@ int erts_is_allctr_wrapper_prelocked(void)
&& !!erts_tsd_get(erts_allctr_prelock_tsd_key); /* by me */
}
+#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
+
+ERTS_ALC_FORCE_INLINE
+int erts_is_in_literal_range(void* ptr)
+{
+#if defined(ARCH_32)
+ Uint ix = (UWord)ptr >> ERTS_MMAP_SUPERALIGNED_BITS;
+
+ return erts_literal_vspace_map[ix / ERTS_VSPACE_WORD_BITS]
+ & ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+
+#elif defined(ARCH_64)
+ extern char* erts_literals_start;
+ extern UWord erts_literals_size;
+ return ErtsInArea(ptr, erts_literals_start, erts_literals_size);
+#else
+# error No ARCH_xx
+#endif
+}
+
+#endif /* ERTS_HAVE_IS_IN_LITERAL_RANGE */
+
#endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */
#define ERTS_ALC_GET_THR_IX() ((int) erts_get_scheduler_id())
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 7738531142..2932adca84 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -86,11 +86,7 @@ allocator LONG_LIVED true ll_alloc
allocator EHEAP true eheap_alloc
allocator ETS true ets_alloc
allocator FIXED_SIZE true fix_alloc
-
-+if halfword
-allocator LONG_LIVED_LOW true ll_low_alloc
-allocator STANDARD_LOW true std_low_alloc
-+endif
+allocator LITERAL true literal_alloc
+else # Non smp build
@@ -101,11 +97,7 @@ allocator LONG_LIVED false ll_alloc
allocator EHEAP false eheap_alloc
allocator ETS false ets_alloc
allocator FIXED_SIZE false fix_alloc
-
-+if halfword
-allocator LONG_LIVED_LOW false ll_low_alloc
-allocator STANDARD_LOW false std_low_alloc
-+endif
+allocator LITERAL false literal_alloc
+endif
@@ -160,6 +152,8 @@ type OLD_HEAP EHEAP PROCESSES old_heap
type HEAP_FRAG EHEAP PROCESSES heap_frag
type TMP_HEAP TEMPORARY PROCESSES tmp_heap
type MSG_REF FIXED_SIZE PROCESSES msg_ref
+type MSG EHEAP PROCESSES message
+type MSGQ_CHNG SHORT_LIVED PROCESSES messages_queue_change
type MSG_ROOTS TEMPORARY PROCESSES msg_roots
type ROOTSET TEMPORARY PROCESSES root_set
type LOADER_TMP TEMPORARY CODE loader_tmp
@@ -349,34 +343,11 @@ type SSB SHORT_LIVED PROCESSES ssb
+endif
-
-+if halfword
-
-type DDLL_PROCESS STANDARD_LOW SYSTEM ddll_processes
-type MONITOR_LH STANDARD_LOW PROCESSES monitor_lh
-type NLINK_LH STANDARD_LOW PROCESSES nlink_lh
-type CODE LONG_LIVED_LOW CODE code
-type DB_HEIR_DATA STANDARD_LOW ETS db_heir_data
-type DB_MS_PSDO_PROC LONG_LIVED_LOW ETS db_match_pseudo_proc
-type SCHDLR_DATA LONG_LIVED_LOW SYSTEM scheduler_data
-type LL_TEMP_TERM LONG_LIVED_LOW SYSTEM ll_temp_term
-
-type NIF_TRAP_EXPORT STANDARD_LOW CODE nif_trap_export_entry
-type EXPORT LONG_LIVED_LOW CODE export_entry
-type MONITOR_SH STANDARD_LOW PROCESSES monitor_sh
-type NLINK_SH STANDARD_LOW PROCESSES nlink_sh
-type AINFO_REQ STANDARD_LOW SYSTEM alloc_info_request
-type SCHED_WTIME_REQ STANDARD_LOW SYSTEM sched_wall_time_request
-type GC_INFO_REQ STANDARD_LOW SYSTEM gc_info_request
-type PORT_DATA_HEAP STANDARD_LOW SYSTEM port_data_heap
-type SYS_CHECK_REQ STANDARD_LOW SYSTEM system_check_request
-
-+else # "fullword"
-
type DDLL_PROCESS STANDARD SYSTEM ddll_processes
type MONITOR_LH STANDARD PROCESSES monitor_lh
type NLINK_LH STANDARD PROCESSES nlink_lh
type CODE LONG_LIVED CODE code
+type LITERAL LITERAL CODE literal
type DB_HEIR_DATA STANDARD ETS db_heir_data
type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc
type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data
@@ -390,11 +361,9 @@ type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request
type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request
type GC_INFO_REQ SHORT_LIVED SYSTEM gc_info_request
type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap
+type MSACC DRIVER SYSTEM microstate_accounting
type SYS_CHECK_REQ SHORT_LIVED SYSTEM system_check_request
-+endif
-
-
#
# Types used by system specific code
#
@@ -432,21 +401,6 @@ type SYS_WRITE_BUF BINARY SYSTEM sys_write_buf
+endif
-+if ose
-
-type SYS_READ_BUF TEMPORARY SYSTEM sys_read_buf
-type FD_TAB LONG_LIVED SYSTEM fd_tab
-type FD_ENTRY_BUF STANDARD SYSTEM fd_entry_buf
-type FD_SIG_LIST SHORT_LIVED SYSTEM fd_sig_list
-type DRV_EV STANDARD SYSTEM driver_event
-type CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path
-type ENVIRONMENT TEMPORARY SYSTEM environment
-type PUTENV_STR SYSTEM SYSTEM putenv_string
-type PRT_REP_EXIT STANDARD SYSTEM port_report_exit
-
-+endif
-
-
+if win32
type DRV_DATA_BUF SYSTEM SYSTEM drv_data_buf
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index 8229a15824..3230b6ef34 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -751,12 +751,77 @@ internal_free(void *ptr)
#endif
+#ifdef ARCH_32
+
+/*
+ * Bit vector for the entire 32-bit virtual address space
+ * with one bit for each super aligned memory segment.
+ */
+
+#define VSPACE_MAP_BITS (1 << (32 - ERTS_MMAP_SUPERALIGNED_BITS))
+#define VSPACE_MAP_SZ (VSPACE_MAP_BITS / ERTS_VSPACE_WORD_BITS)
+
+static ERTS_INLINE void set_bit(UWord* map, Uint ix)
+{
+ ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ);
+ map[ix / ERTS_VSPACE_WORD_BITS]
+ |= ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+}
+
+static ERTS_INLINE void clr_bit(UWord* map, Uint ix)
+{
+ ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ);
+ map[ix / ERTS_VSPACE_WORD_BITS]
+ &= ~((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+}
+
+static ERTS_INLINE int is_bit_set(UWord* map, Uint ix)
+{
+ ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ);
+ return map[ix / ERTS_VSPACE_WORD_BITS]
+ & ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+}
+
+UWord erts_literal_vspace_map[VSPACE_MAP_SZ];
+
+static void set_literal_range(void* start, Uint size)
+{
+ Uint ix = (UWord)start >> ERTS_MMAP_SUPERALIGNED_BITS;
+ Uint n = size >> ERTS_MMAP_SUPERALIGNED_BITS;
+
+ ASSERT(!((UWord)start & ERTS_INV_SUPERALIGNED_MASK));
+ ASSERT(!((UWord)size & ERTS_INV_SUPERALIGNED_MASK));
+ ASSERT(n);
+ while (n--) {
+ ASSERT(!is_bit_set(erts_literal_vspace_map, ix));
+ set_bit(erts_literal_vspace_map, ix);
+ ix++;
+ }
+}
+
+static void clear_literal_range(void* start, Uint size)
+{
+ Uint ix = (UWord)start >> ERTS_MMAP_SUPERALIGNED_BITS;
+ Uint n = size >> ERTS_MMAP_SUPERALIGNED_BITS;
+
+ ASSERT(!((UWord)start & ERTS_INV_SUPERALIGNED_MASK));
+ ASSERT(!((UWord)size & ERTS_INV_SUPERALIGNED_MASK));
+ ASSERT(n);
+ while (n--) {
+ ASSERT(is_bit_set(erts_literal_vspace_map, ix));
+ clr_bit(erts_literal_vspace_map, ix);
+ ix++;
+ }
+}
+
+#endif /* ARCH_32 */
+
/* mseg ... */
#if HAVE_ERTS_MSEG
-static ERTS_INLINE void *
-alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+void*
+erts_alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
{
void *res;
UWord size = (UWord) *size_p;
@@ -766,8 +831,9 @@ alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
return res;
}
-static ERTS_INLINE void *
-alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p)
+void*
+erts_alcu_mseg_realloc(Allctr_t *allctr, void *seg,
+ Uint old_size, Uint *new_size_p)
{
void *res;
UWord new_size = (UWord) *new_size_p;
@@ -778,17 +844,103 @@ alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p)
return res;
}
-static ERTS_INLINE void
-alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags)
+void
+erts_alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags)
{
erts_mseg_dealloc_opt(allctr->alloc_no, seg, (UWord) size, flags, &allctr->mseg_opt);
INC_CC(allctr->calls.mseg_dealloc);
}
-#endif
-static ERTS_INLINE void *
-alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
+#if defined(ARCH_32)
+
+void*
+erts_alcu_literal_32_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+{
+ void* res;
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ res = erts_alcu_mseg_alloc(allctr, size_p, flags);
+ if (res)
+ set_literal_range(res, *size_p);
+ return res;
+}
+
+void*
+erts_alcu_literal_32_mseg_realloc(Allctr_t *allctr, void *seg,
+ Uint old_size, Uint *new_size_p)
+{
+ void* res;
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ if (seg && old_size)
+ clear_literal_range(seg, old_size);
+ res = erts_alcu_mseg_realloc(allctr, seg, old_size, new_size_p);
+ if (res)
+ set_literal_range(res, *new_size_p);
+ return res;
+}
+
+void
+erts_alcu_literal_32_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size,
+ Uint flags)
+{
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ erts_alcu_mseg_dealloc(allctr, seg, size, flags);
+
+ clear_literal_range(seg, size);
+}
+
+#elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+
+void*
+erts_alcu_literal_64_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+{
+ void* res;
+ UWord size = (UWord) *size_p;
+ Uint32 mmap_flags = ERTS_MMAPFLG_SUPERCARRIER_ONLY;
+ if (flags & ERTS_MSEG_FLG_2POW)
+ mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
+
+ res = erts_mmap(&erts_literal_mmapper, mmap_flags, &size);
+ *size_p = (Uint)size;
+ INC_CC(allctr->calls.mseg_alloc);
+ return res;
+}
+
+void*
+erts_alcu_literal_64_mseg_realloc(Allctr_t *allctr, void *seg,
+ Uint old_size, Uint *new_size_p)
+{
+ void *res;
+ UWord new_size = (UWord) *new_size_p;
+ res = erts_mremap(&erts_literal_mmapper, ERTS_MSEG_FLG_NONE, seg, old_size, &new_size);
+ *new_size_p = (Uint) new_size;
+ INC_CC(allctr->calls.mseg_realloc);
+ return res;
+}
+
+void
+erts_alcu_literal_64_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size,
+ Uint flags)
+{
+ Uint32 mmap_flags = ERTS_MMAPFLG_SUPERCARRIER_ONLY;
+ if (flags & ERTS_MSEG_FLG_2POW)
+ mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
+
+ erts_munmap(&erts_literal_mmapper, mmap_flags, seg, (UWord)size);
+ INC_CC(allctr->calls.mseg_dealloc);
+}
+#endif /* ARCH_64 && ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION */
+
+#endif /* HAVE_ERTS_MSEG */
+
+void*
+erts_alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
{
void *res;
#if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
@@ -803,8 +955,8 @@ alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
return res;
}
-static ERTS_INLINE void *
-alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign)
+void*
+erts_alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign)
{
void *res;
@@ -824,8 +976,8 @@ alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int supe
return res;
}
-static ERTS_INLINE void
-alcu_sys_free(Allctr_t *allctr, void *ptr, int superalign)
+void
+erts_alcu_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign)
{
#if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
if (superalign)
@@ -838,6 +990,49 @@ alcu_sys_free(Allctr_t *allctr, void *ptr, int superalign)
erts_mtrace_crr_free(allctr->alloc_no, ERTS_ALC_A_SYSTEM, ptr);
}
+#ifdef ARCH_32
+
+void*
+erts_alcu_literal_32_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
+{
+ void* res;
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ res = erts_alcu_sys_alloc(allctr, size, 1);
+ if (res)
+ set_literal_range(res, size);
+ return res;
+}
+
+void*
+erts_alcu_literal_32_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign)
+{
+ void* res;
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ if (ptr && old_size)
+ clear_literal_range(ptr, old_size);
+ res = erts_alcu_sys_realloc(allctr, ptr, size, old_size, 1);
+ if (res)
+ set_literal_range(res, size);
+ return res;
+}
+
+void
+erts_alcu_literal_32_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign)
+{
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ erts_alcu_sys_dealloc(allctr, ptr, size, 1);
+
+ clear_literal_range(ptr, size);
+}
+
+#endif /* ARCH_32 */
+
static Uint
get_next_mbc_size(Allctr_t *allctr)
{
@@ -2084,7 +2279,7 @@ mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp)
if (!blk) {
blk = create_carrier(allctr, get_blk_sz, CFLG_MBC);
-#if !HALFWORD_HEAP && !ERTS_SUPER_ALIGNED_MSEG_ONLY
+#if !ERTS_SUPER_ALIGNED_MSEG_ONLY
if (!blk) {
/* Emergency! We couldn't create the carrier as we wanted.
Try to place it in a sys_alloced sbc. */
@@ -3531,8 +3726,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
int is_mseg = 0;
#endif
- if (HALFWORD_HEAP
- || (ERTS_SUPER_ALIGNED_MSEG_ONLY && (flags & CFLG_MBC))
+ if ((ERTS_SUPER_ALIGNED_MSEG_ONLY && (flags & CFLG_MBC))
|| !allow_sys_alloc_carriers) {
flags |= CFLG_FORCE_MSEG;
flags &= ~CFLG_FORCE_SYS_ALLOC;
@@ -3540,6 +3734,8 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
return NULL;
#endif
}
+ flags |= allctr->crr_set_flgs;
+ flags &= ~allctr->crr_clr_flgs;
ASSERT((flags & CFLG_SBC && !(flags & CFLG_MBC))
|| (flags & CFLG_MBC && !(flags & CFLG_SBC)));
@@ -3555,7 +3751,21 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
return NULL;
}
- blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz);
+ if (flags & CFLG_MAIN_CARRIER) {
+ ASSERT(flags & CFLG_MBC);
+ ASSERT(flags & CFLG_NO_CPOOL);
+ ASSERT(umem_sz == allctr->main_carrier_size);
+ ERTS_UNDEF(blk_sz, 0);
+
+ if (allctr->main_carrier_size < allctr->min_mbc_size)
+ allctr->main_carrier_size = allctr->min_mbc_size;
+ crr_sz = bcrr_sz = allctr->main_carrier_size;
+ }
+ else {
+ ERTS_UNDEF(bcrr_sz, 0);
+ ERTS_UNDEF(crr_sz, 0);
+ blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz);
+ }
#ifdef ERTS_SMP
allctr->cpool.disable_abandon = ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON;
@@ -3601,13 +3811,15 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
mseg_flags = ERTS_MSEG_FLG_NONE;
}
else {
- crr_sz = (*allctr->get_next_mbc_size)(allctr);
- if (crr_sz < MBC_HEADER_SIZE(allctr) + blk_sz)
- crr_sz = MBC_HEADER_SIZE(allctr) + blk_sz;
- mseg_flags = ERTS_MSEG_FLG_2POW;
+ if (!(flags & CFLG_MAIN_CARRIER)) {
+ crr_sz = (*allctr->get_next_mbc_size)(allctr);
+ if (crr_sz < MBC_HEADER_SIZE(allctr) + blk_sz)
+ crr_sz = MBC_HEADER_SIZE(allctr) + blk_sz;
+ }
+ mseg_flags = ERTS_MSEG_FLG_2POW;
}
- crr = (Carrier_t *) alcu_mseg_alloc(allctr, &crr_sz, mseg_flags);
+ crr = (Carrier_t *) allctr->mseg_alloc(allctr, &crr_sz, mseg_flags);
if (!crr) {
have_tried_mseg = 1;
if (!(have_tried_sys_alloc || flags & CFLG_FORCE_MSEG))
@@ -3639,23 +3851,22 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
if (flags & CFLG_SBC) {
bcrr_sz = blk_sz + SBC_HEADER_SIZE;
}
- else {
+ else if (!(flags & CFLG_MAIN_CARRIER)) {
bcrr_sz = MBC_HEADER_SIZE(allctr) + blk_sz;
- if (!(flags & CFLG_MAIN_CARRIER)
- && bcrr_sz < allctr->smallest_mbc_size)
- bcrr_sz = allctr->smallest_mbc_size;
+ if (bcrr_sz < allctr->smallest_mbc_size)
+ bcrr_sz = allctr->smallest_mbc_size;
}
crr_sz = (flags & CFLG_FORCE_SIZE
? UNIT_CEILING(bcrr_sz)
: SYS_ALLOC_CARRIER_CEILING(bcrr_sz));
- crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
+ crr = (Carrier_t *) allctr->sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
if (!crr) {
if (crr_sz > UNIT_CEILING(bcrr_sz)) {
crr_sz = UNIT_CEILING(bcrr_sz);
- crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
+ crr = (Carrier_t *) allctr->sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
}
if (!crr) {
#if HAVE_ERTS_MSEG
@@ -3754,7 +3965,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
new_crr_sz = new_blk_sz + SBC_HEADER_SIZE;
new_crr_sz = ERTS_SACRR_UNIT_CEILING(new_crr_sz);
- new_crr = (Carrier_t *) alcu_mseg_realloc(allctr,
+ new_crr = (Carrier_t *) allctr->mseg_realloc(allctr,
old_crr,
old_crr_sz,
&new_crr_sz);
@@ -3769,11 +3980,6 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
DEBUG_SAVE_ALIGNMENT(new_crr);
return new_blk;
}
-#if HALFWORD_HEAP
- /* Old carrier unchanged; restore stat */
- STAT_MSEG_SBC_ALLOC(allctr, old_crr_sz, old_blk_sz);
- return NULL;
-#endif
create_flags |= CFLG_FORCE_SYS_ALLOC; /* since mseg_realloc()
failed */
}
@@ -3784,7 +3990,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
(void *) BLK2UMEM(old_blk),
MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ);
unlink_carrier(&allctr->sbc_list, old_crr);
- alcu_mseg_dealloc(allctr, old_crr, old_crr_sz, ERTS_MSEG_FLG_NONE);
+ allctr->mseg_dealloc(allctr, old_crr, old_crr_sz, ERTS_MSEG_FLG_NONE);
}
else {
/* Old carrier unchanged; restore stat */
@@ -3801,7 +4007,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
? UNIT_CEILING(new_bcrr_sz)
: SYS_ALLOC_CARRIER_CEILING(new_bcrr_sz));
- new_crr = (Carrier_t *) alcu_sys_realloc(allctr,
+ new_crr = (Carrier_t *) allctr->sys_realloc(allctr,
(void *) old_crr,
new_crr_sz,
old_crr_sz,
@@ -3822,7 +4028,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
else if (new_crr_sz > UNIT_CEILING(new_bcrr_sz)) {
new_crr_sz = new_blk_sz + SBC_HEADER_SIZE;
new_crr_sz = UNIT_CEILING(new_crr_sz);
- new_crr = (Carrier_t *) alcu_sys_realloc(allctr,
+ new_crr = (Carrier_t *) allctr->sys_realloc(allctr,
(void *) old_crr,
new_crr_sz,
old_crr_sz,
@@ -3845,7 +4051,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
(void *) BLK2UMEM(old_blk),
MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ);
unlink_carrier(&allctr->sbc_list, old_crr);
- alcu_sys_free(allctr, old_crr, 0);
+ allctr->sys_dealloc(allctr, old_crr, CARRIER_SZ(old_crr), 0);
}
else {
/* Old carrier unchanged; restore... */
@@ -3861,13 +4067,13 @@ dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, int superaligned)
{
#if HAVE_ERTS_MSEG
if (IS_MSEG_CARRIER(crr))
- alcu_mseg_dealloc(allctr, crr, CARRIER_SZ(crr),
+ allctr->mseg_dealloc(allctr, crr, CARRIER_SZ(crr),
(superaligned
? ERTS_MSEG_FLG_2POW
: ERTS_MSEG_FLG_NONE));
else
#endif
- alcu_sys_free(allctr, crr, superaligned);
+ allctr->sys_dealloc(allctr, crr, CARRIER_SZ(crr), superaligned);
}
static void
@@ -3962,9 +4168,6 @@ static struct {
Eterm e;
Eterm t;
Eterm ramv;
-#if HALFWORD_HEAP
- Eterm low;
-#endif
Eterm sbct;
#if HAVE_ERTS_MSEG
Eterm asbcst;
@@ -4055,9 +4258,6 @@ init_atoms(Allctr_t *allctr)
AM_INIT(e);
AM_INIT(t);
AM_INIT(ramv);
-#if HALFWORD_HEAP
- AM_INIT(low);
-#endif
AM_INIT(sbct);
#if HAVE_ERTS_MSEG
AM_INIT(asbcst);
@@ -4663,9 +4863,6 @@ info_options(Allctr_t *allctr,
"option e: true\n"
"option t: %s\n"
"option ramv: %s\n"
-#if HALFWORD_HEAP
- "option low: %s\n"
-#endif
"option sbct: %beu\n"
#if HAVE_ERTS_MSEG
"option asbcst: %bpu\n"
@@ -4684,9 +4881,6 @@ info_options(Allctr_t *allctr,
"option acul: %d\n",
topt,
allctr->ramv ? "true" : "false",
-#if HALFWORD_HEAP
- allctr->mseg_opt.low_mem ? "true" : "false",
-#endif
allctr->sbc_threshold,
#if HAVE_ERTS_MSEG
allctr->mseg_opt.abs_shrink_th,
@@ -4749,9 +4943,6 @@ info_options(Allctr_t *allctr,
add_2tup(hpp, szp, &res,
am.sbct,
bld_uint(hpp, szp, allctr->sbc_threshold));
-#if HALFWORD_HEAP
- add_2tup(hpp, szp, &res, am.low, allctr->mseg_opt.low_mem ? am_true : am_false);
-#endif
add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false);
add_2tup(hpp, szp, &res, am.t, (allctr->t ? am_true : am_false));
add_2tup(hpp, szp, &res, am.e, am_true);
@@ -5146,6 +5337,11 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
{
void *res;
+#ifdef ERTS_SMP
+ ASSERT(!"This is not thread safe");
+#elif defined(USE_THREADS)
+ ASSERT(erts_equal_tids(erts_main_thread, erts_thr_self()));
+#endif
res = do_erts_alcu_alloc(type, extra, size);
DEBUG_CHECK_ALIGNMENT(res);
return res;
@@ -5436,11 +5632,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
Block_t *new_blk;
if(IS_SBC_BLK(blk)) {
do_carrier_resize:
-#if HALFWORD_HEAP
- new_blk = resize_carrier(allctr, blk, size, CFLG_SBC | CFLG_FORCE_MSEG);
-#else
new_blk = resize_carrier(allctr, blk, size, CFLG_SBC);
-#endif
res = new_blk ? BLK2UMEM(new_blk) : NULL;
}
else if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE)
@@ -5734,11 +5926,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
#ifdef ERTS_SMP
if (init->tspec || init->tpref)
allctr->mseg_opt.sched_spec = 1;
-#endif
-# if HALFWORD_HEAP
- allctr->mseg_opt.low_mem = init->low_mem;
-# endif
-#endif
+#endif /* ERTS_SMP */
+#endif /* HAVE_ERTS_MSEG */
allctr->name_prefix = init->name_prefix;
if (!allctr->name_prefix)
@@ -5887,17 +6076,52 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
+ ABLK_HDR_SZ)
- ABLK_HDR_SZ);
+ if (init->sys_alloc) {
+ ASSERT(init->sys_realloc && init->sys_dealloc);
+ allctr->sys_alloc = init->sys_alloc;
+ allctr->sys_realloc = init->sys_realloc;
+ allctr->sys_dealloc = init->sys_dealloc;
+ }
+ else {
+ ASSERT(!init->sys_realloc && !init->sys_dealloc);
+ allctr->sys_alloc = &erts_alcu_sys_alloc;
+ allctr->sys_realloc = &erts_alcu_sys_realloc;
+ allctr->sys_dealloc = &erts_alcu_sys_dealloc;
+ }
+#if HAVE_ERTS_MSEG
+ if (init->mseg_alloc) {
+ ASSERT(init->mseg_realloc && init->mseg_dealloc);
+ allctr->mseg_alloc = init->mseg_alloc;
+ allctr->mseg_realloc = init->mseg_realloc;
+ allctr->mseg_dealloc = init->mseg_dealloc;
+ }
+ else {
+ ASSERT(!init->mseg_realloc && !init->mseg_dealloc);
+ allctr->mseg_alloc = &erts_alcu_mseg_alloc;
+ allctr->mseg_realloc = &erts_alcu_mseg_realloc;
+ allctr->mseg_dealloc = &erts_alcu_mseg_dealloc;
+ }
+ /* If a custom carrier alloc function is specified, make sure it's used */
+ if (init->mseg_alloc && !init->sys_alloc) {
+ allctr->crr_set_flgs = CFLG_FORCE_MSEG;
+ allctr->crr_clr_flgs = CFLG_FORCE_SYS_ALLOC;
+ }
+ else if (!init->mseg_alloc && init->sys_alloc) {
+ allctr->crr_set_flgs = CFLG_FORCE_SYS_ALLOC;
+ allctr->crr_clr_flgs = CFLG_FORCE_MSEG;
+ }
+#endif
+
if (allctr->main_carrier_size) {
Block_t *blk;
blk = create_carrier(allctr,
allctr->main_carrier_size,
- CFLG_MBC
+ (ERTS_SUPER_ALIGNED_MSEG_ONLY
+ ? CFLG_FORCE_MSEG : CFLG_FORCE_SYS_ALLOC)
+ | CFLG_MBC
| CFLG_FORCE_SIZE
| CFLG_NO_CPOOL
-#if !HALFWORD_HEAP && !ERTS_SUPER_ALIGNED_MSEG_ONLY
- | CFLG_FORCE_SYS_ALLOC
-#endif
| CFLG_MAIN_CARRIER);
if (!blk) {
#ifdef USE_THREADS
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index f4a2ae7ff3..b7d717ed23 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -24,6 +24,12 @@
#define ERTS_ALCU_VSN_STR "3.0"
#include "erl_alloc_types.h"
+#ifdef USE_THREADS
+#define ERL_THREADS_EMU_INTERNAL__
+#include "erl_threads.h"
+#endif
+
+#include "erl_mseg.h"
#define ERTS_AU_PREF_ALLOC_BITS 11
#define ERTS_AU_MAX_PREF_ALLOC_INSTANCES (1 << ERTS_AU_PREF_ALLOC_BITS)
@@ -45,7 +51,6 @@ typedef struct {
int tspec;
int tpref;
int ramv;
- int low_mem; /* HALFWORD only */
UWord sbct;
UWord asbcst;
UWord rsbcst;
@@ -61,6 +66,15 @@ typedef struct {
void *fix;
size_t *fix_type_size;
+
+#if HAVE_ERTS_MSEG
+ void* (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags);
+ void* (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+ void (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags);
+#endif
+ void* (*sys_alloc)(Allctr_t *allctr, Uint size, int superalign);
+ void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign);
+ void (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign);
} AllctrInit_t;
typedef struct {
@@ -90,7 +104,6 @@ typedef struct {
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
0, /* (bool) ramv: realloc always moves */\
- 0, /* (bool) low_mem: HALFWORD only */\
512*1024, /* (bytes) sbct: sbc threshold */\
2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\
20, /* (%) rsbcst: rel sbc shrink threshold */\
@@ -125,7 +138,6 @@ typedef struct {
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
0, /* (bool) ramv: realloc always moves */\
- 0, /* (bool) low_mem: HALFWORD only */\
64*1024, /* (bytes) sbct: sbc threshold */\
2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\
20, /* (%) rsbcst: rel sbc shrink threshold */\
@@ -176,20 +188,44 @@ void erts_alcu_check_delayed_dealloc(Allctr_t *, int, int *, ErtsThrPrgrVal *
#endif
erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
+#ifdef ARCH_32
+extern UWord erts_literal_vspace_map[];
+# define ERTS_VSPACE_WORD_BITS (sizeof(UWord)*8)
+#endif
+
+void* erts_alcu_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void erts_alcu_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+
+#if HAVE_ERTS_MSEG
+# if defined(ARCH_32)
+void* erts_alcu_literal_32_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_literal_32_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void erts_alcu_literal_32_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+
+# elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+void* erts_alcu_literal_64_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_literal_64_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void erts_alcu_literal_64_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+# endif
+#endif /* HAVE_ERTS_MSEG */
+
+void* erts_alcu_sys_alloc(Allctr_t*, Uint size, int superalign);
+void* erts_alcu_sys_realloc(Allctr_t*, void *ptr, Uint size, Uint old_size, int superalign);
+void erts_alcu_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign);
+#ifdef ARCH_32
+void* erts_alcu_literal_32_sys_alloc(Allctr_t*, Uint size, int superalign);
+void* erts_alcu_literal_32_sys_realloc(Allctr_t*, void *ptr, Uint size, Uint old_size, int superalign);
+void erts_alcu_literal_32_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign);
#endif
+#endif /* !ERL_ALLOC_UTIL__ */
+
#if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__)
#define ERL_ALLOC_UTIL_IMPL__
#define ERTS_ALCU_FLG_FAIL_REALLOC_MOVE (((Uint32) 1) << 0)
-#ifdef USE_THREADS
-#define ERL_THREADS_EMU_INTERNAL__
-#include "erl_threads.h"
-#endif
-
-#include "erl_mseg.h"
-
#undef ERTS_ALLOC_UTIL_HARD_DEBUG
#ifdef DEBUG
# if 0
@@ -223,7 +259,7 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
#if ERTS_HAVE_MSEG_SUPER_ALIGNED \
|| (!HAVE_ERTS_MSEG && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC)
-# ifndef MSEG_ALIGN_BITS
+# ifdef MSEG_ALIGN_BITS
# define ERTS_SUPER_ALIGN_BITS MSEG_ALIGN_BITS
# else
# define ERTS_SUPER_ALIGN_BITS 18
@@ -501,6 +537,8 @@ struct Allctr_t_ {
Uint min_mbc_size;
Uint min_mbc_first_free_size;
Uint min_block_size;
+ UWord crr_set_flgs;
+ UWord crr_clr_flgs;
/* Carriers */
CarrierList_t mbc_list;
@@ -546,6 +584,15 @@ struct Allctr_t_ {
void (*remove_mbc) (Allctr_t *, Carrier_t *);
UWord (*largest_fblk_in_mbc) (Allctr_t *, Carrier_t *);
+#if HAVE_ERTS_MSEG
+ void* (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags);
+ void* (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+ void (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags);
+#endif
+ void* (*sys_alloc)(Allctr_t *allctr, Uint size, int superalign);
+ void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign);
+ void (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign);
+
void (*init_atoms) (void);
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c
index b8c5ef9b09..3671025d22 100644
--- a/erts/emulator/beam/erl_arith.c
+++ b/erts/emulator/beam/erl_arith.c
@@ -42,15 +42,8 @@
# define MAX(x, y) (((x) > (y)) ? (x) : (y))
#endif
-#if !HEAP_ON_C_STACK
-# define DECLARE_TMP(VariableName,N,P) \
- Eterm *VariableName = ((ERTS_PROC_GET_SCHDATA(P)->erl_arith_tmp_heap) + (2 * N))
-#else
-# define DECLARE_TMP(VariableName,N,P) \
- Eterm VariableName[2]
-#endif
-# define ARG_IS_NOT_TMP(Arg,Tmp) ((Arg) != make_big((Tmp)))
-
+#define DECLARE_TMP(VariableName,N,P) Eterm VariableName[2]
+#define ARG_IS_NOT_TMP(Arg,Tmp) ((Arg) != make_big((Tmp)))
static Eterm shift(Process* p, Eterm arg1, Eterm arg2, int right);
diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c
index f071898046..cdeeb5281b 100644
--- a/erts/emulator/beam/erl_async.c
+++ b/erts/emulator/beam/erl_async.c
@@ -167,7 +167,6 @@ async_ready_q(Uint sched_id)
#endif
-
void
erts_init_async(void)
{
@@ -401,13 +400,19 @@ static ERTS_INLINE void call_async_ready(ErtsAsync *a)
ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
#endif
if (!p) {
- if (a->async_free)
+ if (a->async_free) {
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT);
a->async_free(a->async_data);
+ ERTS_MSACC_POP_STATE();
+ }
}
else {
if (async_ready(p, a->async_data)) {
- if (a->async_free)
+ if (a->async_free) {
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT);
a->async_free(a->async_data);
+ ERTS_MSACC_POP_STATE();
+ }
}
#if ERTS_USE_ASYNC_READY_Q
erts_port_release(p);
@@ -461,6 +466,8 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq)
{
ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT;
erts_tse_t *tse = erts_tse_fetch();
+ ERTS_DECLARE_DUMMY(Uint no);
+
#ifdef ERTS_SMP
ErtsThrPrgrCallbacks callbacks;
@@ -484,10 +491,12 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq)
/* Inform main thread that we are done initializing... */
erts_mtx_lock(&async->init.data.mtx);
- async->init.data.no_initialized++;
+ no = async->init.data.no_initialized++;
erts_cnd_signal(&async->init.data.cnd);
erts_mtx_unlock(&async->init.data.mtx);
+ erts_msacc_init_thread("async", no, 0);
+
return tse;
}
@@ -495,6 +504,7 @@ static void *async_main(void* arg)
{
ErtsAsyncQ *aq = (ErtsAsyncQ *) arg;
erts_tse_t *tse = async_thread_init(aq);
+ ERTS_MSACC_DECLARE_CACHE();
while (1) {
ErtsThrQPrepEnQ_t *prep_enq;
@@ -502,11 +512,14 @@ static void *async_main(void* arg)
if (is_nil(a->port))
break; /* Time to die */
+ ERTS_MSACC_UPDATE_CACHE();
+
#if ERTS_ASYNC_PRINT_JOB
erts_fprintf(stderr, "<- %ld\n", a->async_id);
#endif
-
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT);
a->async_invoke(a->async_data);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER);
async_reply(a, prep_enq);
}
@@ -629,10 +642,13 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
unsigned int qix;
#if ERTS_USE_ASYNC_READY_Q
Uint sched_id;
+ ERTS_MSACC_PUSH_STATE();
sched_id = erts_get_scheduler_id();
if (!sched_id)
sched_id = 1;
+#else
+ ERTS_MSACC_PUSH_STATE();
#endif
prt = erts_drvport2port(ix);
@@ -685,12 +701,17 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
return id;
}
#endif
-
+
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT);
(*a->async_invoke)(a->async_data);
+ ERTS_MSACC_POP_STATE();
if (async_ready(prt, a->async_data)) {
- if (a->async_free != NULL)
+ if (a->async_free != NULL) {
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT);
(*a->async_free)(a->async_data);
+ ERTS_MSACC_POP_STATE();
+ }
}
erts_free(ERTS_ALC_T_ASYNC, (void *) a);
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 134aa2d396..aec72bd61a 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -55,10 +55,8 @@
/* Init and local variables */
-static Export binary_match_trap_export;
-static BIF_RETTYPE binary_match_trap(BIF_ALIST_3);
-static Export binary_matches_trap_export;
-static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3);
+static Export binary_find_trap_export;
+static BIF_RETTYPE binary_find_trap(BIF_ALIST_3);
static Export binary_longest_prefix_trap_export;
static BIF_RETTYPE binary_longest_prefix_trap(BIF_ALIST_3);
static Export binary_longest_suffix_trap_export;
@@ -70,19 +68,15 @@ static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2);
static Uint max_loop_limit;
static BIF_RETTYPE
-binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags);
static BIF_RETTYPE
-binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
+binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
void erts_init_bif_binary(void)
{
- erts_init_trap_export(&binary_match_trap_export,
- am_erlang, am_binary_match_trap, 3,
- &binary_match_trap);
-
- erts_init_trap_export(&binary_matches_trap_export,
- am_erlang, am_binary_matches_trap, 3,
- &binary_matches_trap);
+ erts_init_trap_export(&binary_find_trap_export,
+ am_erlang, am_binary_find_trap, 3,
+ &binary_find_trap);
erts_init_trap_export(&binary_longest_prefix_trap_export,
am_erlang, am_binary_longest_prefix_trap, 3,
@@ -314,8 +308,8 @@ static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len,
/*
* Aho Corasick - Build a Trie and fill in the failure functions
* when all strings are added.
- * The algorithm is nicely described by Dieter B�hler of University of
- * T�bingen:
+ * The algorithm is nicely described by Dieter Bühler of University of
+ * Tübingen:
* http://www-sr.informatik.uni-tuebingen.de/~buehler/AC/AC.html
*/
@@ -537,21 +531,23 @@ static void ac_init_find_all(ACFindAllState *state, ACTrie *act, Sint startpos,
state->out = NULL;
}
-static void ac_restore_find_all(ACFindAllState *state, char *buff)
+static void ac_restore_find_all(ACFindAllState *state,
+ const ACFindAllState *src)
{
- memcpy(state,buff,sizeof(ACFindAllState));
+ memcpy(state, src, sizeof(ACFindAllState));
if (state->allocated > 0) {
state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * (state->allocated));
- memcpy(state->out,buff+sizeof(ACFindAllState),sizeof(FindallData)*state->m);
+ memcpy(state->out, src+1, sizeof(FindallData)*state->m);
} else {
state->out = NULL;
}
}
-static void ac_serialize_find_all(ACFindAllState *state, char *buff)
+static void ac_serialize_find_all(const ACFindAllState *state,
+ ACFindAllState *dst)
{
- memcpy(buff,state,sizeof(ACFindAllState));
- memcpy(buff+sizeof(ACFindAllState),state->out,sizeof(FindallData)*state->m);
+ memcpy(dst, state, sizeof(ACFindAllState));
+ memcpy(dst+1, state->out, sizeof(FindallData)*state->m);
}
static void ac_clean_find_all(ACFindAllState *state)
@@ -565,9 +561,6 @@ static void ac_clean_find_all(ACFindAllState *state)
#endif
}
-#define SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(S) \
- (sizeof(ACFindAllState)+(sizeof(FindallData)*(S).m))
-
/*
* Differs to the find_first function in that it stores all matches and the values
* arte returned only in the state.
@@ -814,24 +807,24 @@ static void bm_init_find_all(BMFindAllState *state, Sint startpos, Uint len)
state->out = NULL;
}
-static void bm_restore_find_all(BMFindAllState *state, char *buff)
+static void bm_restore_find_all(BMFindAllState *state,
+ const BMFindAllState *src)
{
- memcpy(state,buff,sizeof(BMFindAllState));
+ memcpy(state, src, sizeof(BMFindAllState));
if (state->allocated > 0) {
state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) *
(state->allocated));
- memcpy(state->out,buff+sizeof(BMFindAllState),
- sizeof(FindallData)*state->m);
+ memcpy(state->out, src+1, sizeof(FindallData)*state->m);
} else {
state->out = NULL;
}
}
-static void bm_serialize_find_all(BMFindAllState *state, char *buff)
+static void bm_serialize_find_all(const BMFindAllState *state,
+ BMFindAllState *dst)
{
- memcpy(buff,state,sizeof(BMFindAllState));
- memcpy(buff+sizeof(BMFindAllState),state->out,
- sizeof(FindallData)*state->m);
+ memcpy(dst, state, sizeof(BMFindAllState));
+ memcpy(dst+1, state->out, sizeof(FindallData)*state->m);
}
static void bm_clean_find_all(BMFindAllState *state)
@@ -845,9 +838,6 @@ static void bm_clean_find_all(BMFindAllState *state)
#endif
}
-#define SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(S) \
- (sizeof(BMFindAllState)+(sizeof(FindallData)*(S).m))
-
/*
* Differs to the find_first function in that it stores all matches and the
* values are returned only in the state.
@@ -1030,283 +1020,142 @@ BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1)
#define DO_BIN_MATCH_BADARG -1
#define DO_BIN_MATCH_RESTART -2
-static int do_binary_match(Process *p, Eterm subject, Uint hsstart, Uint hsend,
- Eterm type, Binary *bin, Eterm state_term,
- Eterm *res_term)
-{
- byte *bytes;
- Uint bitoffs, bitsize;
- byte *temp_alloc = NULL;
-
- ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
- if (bitsize != 0) {
- goto badarg;
- }
- if (bitoffs != 0) {
- bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
- }
- if (state_term != NIL) {
- Eterm *ptr = big_val(state_term);
- type = ptr[1];
- }
-
- if (type == am_bm) {
- BMData *bm;
- Sint pos;
- Eterm ret;
- Eterm *hp;
- BMFindFirstState state;
- Uint reds = get_reds(p, BM_LOOP_FACTOR);
- Uint save_reds = reds;
-
- bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
- dump_bm_data(bm);
-#endif
- if (state_term == NIL) {
- bm_init_find_first_match(&state, hsstart, hsend);
- } else {
- Eterm *ptr = big_val(state_term);
- memcpy(&state,ptr+2,sizeof(state));
- }
-#ifdef HARDDEBUG
- erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos,
- state.len);
-#endif
- pos = bm_find_first_match(&state, bm, bytes, &reds);
- if (pos == BM_NOT_FOUND) {
- ret = am_nomatch;
- } else if (pos == BM_RESTART) {
- int x = (sizeof(BMFindFirstState) / sizeof(Eterm)) +
- !!(sizeof(BMFindFirstState) % sizeof(Eterm));
-#ifdef HARDDEBUG
- erts_printf("Trap bm!\n");
-#endif
- hp = HAlloc(p,x+2);
- hp[0] = make_pos_bignum_header(x+1);
- hp[1] = type;
- memcpy(hp+2,&state,sizeof(state));
- *res_term = make_big(hp);
- erts_free_aligned_binary_bytes(temp_alloc);
- return DO_BIN_MATCH_RESTART;
- } else {
- Eterm erlen = erts_make_integer((Uint) bm->len, p);
- ret = erts_make_integer(pos,p);
- hp = HAlloc(p,3);
- ret = TUPLE2(hp, ret, erlen);
- }
- erts_free_aligned_binary_bytes(temp_alloc);
- BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
- *res_term = ret;
- return DO_BIN_MATCH_OK;
- } else if (type == am_ac) {
- ACTrie *act;
- Uint pos, rlen;
- int acr;
- ACFindFirstState state;
- Eterm ret;
- Eterm *hp;
- Uint reds = get_reds(p, AC_LOOP_FACTOR);
- Uint save_reds = reds;
+#define BINARY_FIND_ALL 0x01
+#define BINARY_SPLIT_TRIM 0x02
+#define BINARY_SPLIT_TRIM_ALL 0x04
- act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
- dump_ac_trie(act);
-#endif
- if (state_term == NIL) {
- ac_init_find_first_match(&state, act, hsstart, hsend);
- } else {
- Eterm *ptr = big_val(state_term);
- memcpy(&state,ptr+2,sizeof(state));
- }
- acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
- if (acr == AC_NOT_FOUND) {
- ret = am_nomatch;
- } else if (acr == AC_RESTART) {
- int x = (sizeof(state) / sizeof(Eterm)) +
- !!(sizeof(ACFindFirstState) % sizeof(Eterm));
-#ifdef HARDDEBUG
- erts_printf("Trap ac!\n");
-#endif
- hp = HAlloc(p,x+2);
- hp[0] = make_pos_bignum_header(x+1);
- hp[1] = type;
- memcpy(hp+2,&state,sizeof(state));
- *res_term = make_big(hp);
- erts_free_aligned_binary_bytes(temp_alloc);
- return DO_BIN_MATCH_RESTART;
- } else {
- Eterm epos = erts_make_integer(pos,p);
- Eterm erlen = erts_make_integer(rlen,p);
- hp = HAlloc(p,3);
- ret = TUPLE2(hp, epos, erlen);
- }
- erts_free_aligned_binary_bytes(temp_alloc);
- BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
- *res_term = ret;
- return DO_BIN_MATCH_OK;
- }
- badarg:
- return DO_BIN_MATCH_BADARG;
-}
+typedef struct BinaryFindState {
+ Eterm type;
+ Uint flags;
+ Uint hsstart;
+ Uint hsend;
+ Eterm (*not_found_result) (Process *, Eterm, struct BinaryFindState *);
+ Eterm (*single_result) (Process *, Eterm, struct BinaryFindState *, Sint, Sint);
+ Eterm (*global_result) (Process *, Eterm, struct BinaryFindState *, FindallData *, Uint);
+} BinaryFindState;
+
+typedef struct BinaryFindState_bignum {
+ Eterm bignum_hdr;
+ BinaryFindState bfs;
+ union {
+ BMFindFirstState bmffs;
+ BMFindAllState bmfas;
+ ACFindFirstState acffs;
+ ACFindAllState acfas;
+ } data;
+} BinaryFindState_bignum;
+
+#define SIZEOF_BINARY_FIND_STATE(S) \
+ (sizeof(BinaryFindState)+sizeof(S))
+
+#define SIZEOF_BINARY_FIND_ALL_STATE(S) \
+ (sizeof(BinaryFindState)+sizeof(S)+(sizeof(FindallData)*(S).m))
+
+static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs);
+static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ Sint pos, Sint len);
+static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ FindallData *fad, Uint fad_sz);
+static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs);
+static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ Sint pos, Sint len);
+static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ FindallData *fad, Uint fad_sz);
-static int do_binary_matches(Process *p, Eterm subject, Uint hsstart,
- Uint hsend, Eterm type, Binary *bin,
- Eterm state_term, Eterm *res_term)
+static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
{
- byte *bytes;
- Uint bitoffs, bitsize;
- byte *temp_alloc = NULL;
-
- ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
- if (bitsize != 0) {
- goto badarg;
- }
- if (bitoffs != 0) {
- bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
- }
- if (state_term != NIL) {
- Eterm *ptr = big_val(state_term);
- type = ptr[1];
- }
-
- if (type == am_bm) {
- BMData *bm;
- Sint pos;
- Eterm ret,tpl;
- Eterm *hp;
- BMFindAllState state;
- Uint reds = get_reds(p, BM_LOOP_FACTOR);
- Uint save_reds = reds;
-
- bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
- dump_bm_data(bm);
-#endif
- if (state_term == NIL) {
- bm_init_find_all(&state, hsstart, hsend);
- } else {
- Eterm *ptr = big_val(state_term);
- bm_restore_find_all(&state,(char *) (ptr+2));
- }
-
- pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
- if (pos == BM_NOT_FOUND) {
- ret = NIL;
- } else if (pos == BM_RESTART) {
- int x =
- (SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
- !!(SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
- erts_printf("Trap bm!\n");
-#endif
- hp = HAlloc(p,x+2);
- hp[0] = make_pos_bignum_header(x+1);
- hp[1] = type;
- bm_serialize_find_all(&state, (char *) (hp+2));
- *res_term = make_big(hp);
- erts_free_aligned_binary_bytes(temp_alloc);
- bm_clean_find_all(&state);
- return DO_BIN_MATCH_RESTART;
- } else {
- FindallData *fad = state.out;
- int i;
- for (i = 0; i < state.m; ++i) {
- fad[i].epos = erts_make_integer(fad[i].pos,p);
- fad[i].elen = erts_make_integer(fad[i].len,p);
+ Eterm *tp;
+ Uint pos;
+ Sint len;
+ if (l == THE_NON_VALUE || l == NIL) {
+ /* Invalid term or NIL, we're called from binary_match(es)_2 or
+ have no options*/
+ *posp = 0;
+ *endp = binary_size(bin);
+ return 0;
+ } else if (is_list(l)) {
+ while(is_list(l)) {
+ Eterm t = CAR(list_val(l));
+ Uint orig_size;
+ if (!is_tuple(t)) {
+ goto badarg;
}
- hp = HAlloc(p,state.m * (3 + 2));
- ret = NIL;
- for (i = state.m - 1; i >= 0; --i) {
- tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
- hp +=3;
- ret = CONS(hp,tpl,ret);
- hp += 2;
+ tp = tuple_val(t);
+ if (arityval(*tp) != 2) {
+ goto badarg;
}
- }
- erts_free_aligned_binary_bytes(temp_alloc);
- bm_clean_find_all(&state);
- BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
- *res_term = ret;
- return DO_BIN_MATCH_OK;
- } else if (type == am_ac) {
- ACTrie *act;
- int acr;
- ACFindAllState state;
- Eterm ret,tpl;
- Eterm *hp;
- Uint reds = get_reds(p, AC_LOOP_FACTOR);
- Uint save_reds = reds;
-
- act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
- dump_ac_trie(act);
-#endif
- if (state_term == NIL) {
- ac_init_find_all(&state, act, hsstart, hsend);
- } else {
- Eterm *ptr = big_val(state_term);
- ac_restore_find_all(&state,(char *) (ptr+2));
- }
- acr = ac_find_all_non_overlapping(&state, bytes, &reds);
- if (acr == AC_NOT_FOUND) {
- ret = NIL;
- } else if (acr == AC_RESTART) {
- int x =
- (SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
- !!(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
- erts_printf("Trap ac!\n");
-#endif
- hp = HAlloc(p,x+2);
- hp[0] = make_pos_bignum_header(x+1);
- hp[1] = type;
- ac_serialize_find_all(&state, (char *) (hp+2));
- *res_term = make_big(hp);
- erts_free_aligned_binary_bytes(temp_alloc);
- ac_clean_find_all(&state);
- return DO_BIN_MATCH_RESTART;
- } else {
- FindallData *fad = state.out;
- int i;
- for (i = 0; i < state.m; ++i) {
- fad[i].epos = erts_make_integer(fad[i].pos,p);
- fad[i].elen = erts_make_integer(fad[i].len,p);
+ if (tp[1] != am_scope || is_not_tuple(tp[2])) {
+ goto badarg;
}
- hp = HAlloc(p,state.m * (3 + 2));
- ret = NIL;
- for (i = state.m - 1; i >= 0; --i) {
- tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
- hp +=3;
- ret = CONS(hp,tpl,ret);
- hp += 2;
+ tp = tuple_val(tp[2]);
+ if (arityval(*tp) != 2) {
+ goto badarg;
+ }
+ if (!term_to_Uint(tp[1], &pos)) {
+ goto badarg;
}
+ if (!term_to_Sint(tp[2], &len)) {
+ goto badarg;
+ }
+ if (len < 0) {
+ Uint lentmp = -(Uint)len;
+ /* overflow */
+ if ((Sint)lentmp < 0) {
+ goto badarg;
+ }
+ len = lentmp;
+ pos -= len;
+ }
+ /* overflow */
+ if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
+ goto badarg;
+ }
+ *endp = len + pos;
+ *posp = pos;
+ if ((orig_size = binary_size(bin)) < pos ||
+ orig_size < (*endp)) {
+ goto badarg;
+ }
+ l = CDR(list_val(l));
}
- erts_free_aligned_binary_bytes(temp_alloc);
- ac_clean_find_all(&state);
- BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
- *res_term = ret;
- return DO_BIN_MATCH_OK;
+ return 0;
+ } else {
+ badarg:
+ return 1;
}
- badarg:
- return DO_BIN_MATCH_BADARG;
}
-static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
+static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uint *optp)
{
Eterm *tp;
Uint pos;
Sint len;
- if (l == ((Eterm) 0) || l == NIL) {
- /* Invalid term or NIL, we're called from binary_match(es)_2 or
- have no options*/
- *posp = 0;
- *endp = binary_size(bin);
+ *optp = 0;
+ *posp = 0;
+ *endp = binary_size(bin);
+ if (l == THE_NON_VALUE || l == NIL) {
return 0;
} else if (is_list(l)) {
while(is_list(l)) {
Eterm t = CAR(list_val(l));
Uint orig_size;
+ if (is_atom(t)) {
+ if (t == am_global) {
+ *optp |= BINARY_FIND_ALL;
+ l = CDR(list_val(l));
+ continue;
+ }
+ if (t == am_trim) {
+ *optp |= BINARY_SPLIT_TRIM;
+ l = CDR(list_val(l));
+ continue;
+ }
+ if (t == am_trim_all) {
+ *optp |= BINARY_SPLIT_TRIM_ALL;
+ l = CDR(list_val(l));
+ continue;
+ }
+ }
if (!is_tuple(t)) {
goto badarg;
}
@@ -1355,48 +1204,207 @@ static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
}
}
-static BIF_RETTYPE binary_match_trap(BIF_ALIST_3)
+static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binary *bin,
+ Eterm state_term, Eterm *res_term)
{
- int runres;
- Eterm result;
- Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
- runres = do_binary_match(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result);
- if (runres == DO_BIN_MATCH_OK) {
- BIF_RET(result);
- } else {
- BUMP_ALL_REDS(BIF_P);
- BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result,
- BIF_ARG_3);
+ byte *bytes;
+ Uint bitoffs, bitsize;
+ byte *temp_alloc = NULL;
+ BinaryFindState_bignum *state_ptr = NULL;
+
+ ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
+ if (bitsize != 0) {
+ goto badarg;
+ }
+ if (bitoffs != 0) {
+ bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
+ }
+ if (state_term != NIL) {
+ state_ptr = (BinaryFindState_bignum *)(big_val(state_term));
+ bfs = &(state_ptr->bfs);
}
-}
-static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3)
-{
- int runres;
- Eterm result;
- Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
- runres = do_binary_matches(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result);
- if (runres == DO_BIN_MATCH_OK) {
- BIF_RET(result);
+ if (bfs->flags & BINARY_FIND_ALL) {
+ if (bfs->type == am_bm) {
+ BMData *bm;
+ Sint pos;
+ BMFindAllState state;
+ Uint reds = get_reds(p, BM_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_bm_data(bm);
+#endif
+ if (state_term == NIL) {
+ bm_init_find_all(&state, bfs->hsstart, bfs->hsend);
+ } else {
+ bm_restore_find_all(&state, &(state_ptr->data.bmfas));
+ }
+
+ pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
+ if (pos == BM_NOT_FOUND) {
+ *res_term = bfs->not_found_result(p, subject, bfs);
+ } else if (pos == BM_RESTART) {
+ int x =
+ (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap bm!\n");
+#endif
+ state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+ state_ptr->bignum_hdr = make_pos_bignum_header(x);
+ memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+ bm_serialize_find_all(&state, &state_ptr->data.bmfas);
+ *res_term = make_big(&state_ptr->bignum_hdr);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ bm_clean_find_all(&state);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ *res_term = bfs->global_result(p, subject, bfs, state.out, state.m);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ bm_clean_find_all(&state);
+ BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+ return DO_BIN_MATCH_OK;
+ } else if (bfs->type == am_ac) {
+ ACTrie *act;
+ int acr;
+ ACFindAllState state;
+ Uint reds = get_reds(p, AC_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_ac_trie(act);
+#endif
+ if (state_term == NIL) {
+ ac_init_find_all(&state, act, bfs->hsstart, bfs->hsend);
+ } else {
+ ac_restore_find_all(&state, &(state_ptr->data.acfas));
+ }
+ acr = ac_find_all_non_overlapping(&state, bytes, &reds);
+ if (acr == AC_NOT_FOUND) {
+ *res_term = bfs->not_found_result(p, subject, bfs);
+ } else if (acr == AC_RESTART) {
+ int x =
+ (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap ac!\n");
+#endif
+ state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+ state_ptr->bignum_hdr = make_pos_bignum_header(x);
+ memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+ ac_serialize_find_all(&state, &state_ptr->data.acfas);
+ *res_term = make_big(&state_ptr->bignum_hdr);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ ac_clean_find_all(&state);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ *res_term = bfs->global_result(p, subject, bfs, state.out, state.m);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ ac_clean_find_all(&state);
+ BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+ return DO_BIN_MATCH_OK;
+ }
} else {
- BUMP_ALL_REDS(BIF_P);
- BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result,
- BIF_ARG_3);
- }
-}
+ if (bfs->type == am_bm) {
+ BMData *bm;
+ Sint pos;
+ BMFindFirstState state;
+ Uint reds = get_reds(p, BM_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_bm_data(bm);
+#endif
+ if (state_term == NIL) {
+ bm_init_find_first_match(&state, bfs->hsstart, bfs->hsend);
+ } else {
+ memcpy(&state, &state_ptr->data.bmffs, sizeof(BMFindFirstState));
+ }
-BIF_RETTYPE binary_match_3(BIF_ALIST_3)
-{
- return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+#ifdef HARDDEBUG
+ erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos,
+ state.len);
+#endif
+ pos = bm_find_first_match(&state, bm, bytes, &reds);
+ if (pos == BM_NOT_FOUND) {
+ *res_term = bfs->not_found_result(p, subject, bfs);
+ } else if (pos == BM_RESTART) {
+ int x =
+ (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap bm!\n");
+#endif
+ state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+ state_ptr->bignum_hdr = make_pos_bignum_header(x);
+ memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+ memcpy(&state_ptr->data.acffs, &state, sizeof(BMFindFirstState));
+ *res_term = make_big(&state_ptr->bignum_hdr);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ *res_term = bfs->single_result(p, subject, bfs, pos, bm->len);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+ return DO_BIN_MATCH_OK;
+ } else if (bfs->type == am_ac) {
+ ACTrie *act;
+ Uint pos, rlen;
+ int acr;
+ ACFindFirstState state;
+ Uint reds = get_reds(p, AC_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_ac_trie(act);
+#endif
+ if (state_term == NIL) {
+ ac_init_find_first_match(&state, act, bfs->hsstart, bfs->hsend);
+ } else {
+ memcpy(&state, &state_ptr->data.acffs, sizeof(ACFindFirstState));
+ }
+ acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
+ if (acr == AC_NOT_FOUND) {
+ *res_term = bfs->not_found_result(p, subject, bfs);
+ } else if (acr == AC_RESTART) {
+ int x =
+ (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap ac!\n");
+#endif
+ state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+ state_ptr->bignum_hdr = make_pos_bignum_header(x);
+ memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+ memcpy(&state_ptr->data.acffs, &state, sizeof(ACFindFirstState));
+ *res_term = make_big(&state_ptr->bignum_hdr);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ *res_term = bfs->single_result(p, subject, bfs, pos, rlen);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+ return DO_BIN_MATCH_OK;
+ }
+ }
+ badarg:
+ return DO_BIN_MATCH_BADARG;
}
static BIF_RETTYPE
-binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags)
{
- Uint hsstart;
- Uint hsend;
+ BinaryFindState bfs;
Eterm *tp;
- Eterm type;
Binary *bin;
Eterm bin_term = NIL;
int runres;
@@ -1405,11 +1413,12 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
if (is_not_binary(arg1)) {
goto badarg;
}
- if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
+ bfs.flags = flags;
+ if (parse_match_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend))) {
goto badarg;
}
- if (hsend == 0) {
- BIF_RET(am_nomatch);
+ if (bfs.hsend == 0) {
+ BIF_RET(do_match_not_found_result(p, arg1, &bfs));
}
if (is_tuple(arg2)) {
tp = tuple_val(arg2);
@@ -1420,21 +1429,24 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
!ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
goto badarg;
}
- type = tp[1];
+ bfs.type = tp[1];
bin = ((ProcBin *) binary_val(tp[2]))->val;
- if (type == am_bm &&
+ if (bfs.type == am_bm &&
ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
goto badarg;
}
- if (type == am_ac &&
+ if (bfs.type == am_ac &&
ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
goto badarg;
}
bin_term = tp[2];
- } else if (do_binary_match_compile(arg2,&type,&bin)) {
+ } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) {
goto badarg;
}
- runres = do_binary_match(p,arg1,hsstart,hsend,type,bin,NIL,&result);
+ bfs.not_found_result = &do_match_not_found_result;
+ bfs.single_result = &do_match_single_result;
+ bfs.global_result = &do_match_global_result;
+ runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result);
if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
@@ -1446,7 +1458,7 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
BIF_RET(result);
case DO_BIN_MATCH_RESTART:
BUMP_ALL_REDS(p);
- BIF_TRAP3(&binary_match_trap_export, p, arg1, result, bin_term);
+ BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term);
default:
goto badarg;
}
@@ -1454,17 +1466,31 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
BIF_ERROR(p,BADARG);
}
+BIF_RETTYPE binary_match_2(BIF_ALIST_2)
+{
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, 0);
+}
+
+BIF_RETTYPE binary_match_3(BIF_ALIST_3)
+{
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, 0);
+}
+
+BIF_RETTYPE binary_matches_2(BIF_ALIST_2)
+{
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, BINARY_FIND_ALL);
+}
+
BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
{
- return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BINARY_FIND_ALL);
}
static BIF_RETTYPE
-binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
{
- Uint hsstart, hsend;
+ BinaryFindState bfs;
Eterm *tp;
- Eterm type;
Binary *bin;
Eterm bin_term = NIL;
int runres;
@@ -1473,11 +1499,12 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
if (is_not_binary(arg1)) {
goto badarg;
}
- if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
+ if (parse_split_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend), &(bfs.flags))) {
goto badarg;
}
- if (hsend == 0) {
- BIF_RET(NIL);
+ if (bfs.hsend == 0) {
+ result = do_split_not_found_result(p, arg1, &bfs);
+ BIF_RET(result);
}
if (is_tuple(arg2)) {
tp = tuple_val(arg2);
@@ -1488,54 +1515,267 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
!ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
goto badarg;
}
- type = tp[1];
+ bfs.type = tp[1];
bin = ((ProcBin *) binary_val(tp[2]))->val;
- if (type == am_bm &&
+ if (bfs.type == am_bm &&
ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
goto badarg;
}
- if (type == am_ac &&
+ if (bfs.type == am_ac &&
ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
goto badarg;
}
bin_term = tp[2];
- } else if (do_binary_match_compile(arg2,&type,&bin)) {
+ } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) {
goto badarg;
}
- runres = do_binary_matches(p,arg1,hsstart,hsend,type,bin,
- NIL,&result);
+ bfs.not_found_result = &do_split_not_found_result;
+ bfs.single_result = &do_split_single_result;
+ bfs.global_result = &do_split_global_result;
+ runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result);
if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
} else if (bin_term == NIL) {
erts_bin_free(bin);
}
- switch (runres) {
+ switch(runres) {
case DO_BIN_MATCH_OK:
BIF_RET(result);
case DO_BIN_MATCH_RESTART:
- BUMP_ALL_REDS(p);
- BIF_TRAP3(&binary_matches_trap_export, p, arg1, result,
- bin_term);
+ BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term);
default:
goto badarg;
}
badarg:
- BIF_ERROR(p,BADARG);
+ BIF_ERROR(p, BADARG);
}
+BIF_RETTYPE binary_split_2(BIF_ALIST_2)
+{
+ return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE);
+}
-BIF_RETTYPE binary_match_2(BIF_ALIST_2)
+BIF_RETTYPE binary_split_3(BIF_ALIST_3)
{
- return binary_match(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+ return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs)
+{
+ if (bfs->flags & BINARY_FIND_ALL) {
+ return NIL;
+ } else {
+ return am_nomatch;
+ }
}
+static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ Sint pos, Sint len)
+{
+ Eterm erlen;
+ Eterm *hp;
+ Eterm ret;
-BIF_RETTYPE binary_matches_2(BIF_ALIST_2)
+ erlen = erts_make_integer((Uint)(len), p);
+ ret = erts_make_integer(pos, p);
+ hp = HAlloc(p, 3);
+ ret = TUPLE2(hp, ret, erlen);
+
+ return ret;
+}
+
+static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ FindallData *fad, Uint fad_sz)
+{
+ Sint i;
+ Eterm tpl;
+ Eterm *hp;
+ Eterm ret;
+
+ for (i = 0; i < fad_sz; ++i) {
+ fad[i].epos = erts_make_integer(fad[i].pos, p);
+ fad[i].elen = erts_make_integer(fad[i].len, p);
+ }
+ hp = HAlloc(p, fad_sz * (3 + 2));
+ ret = NIL;
+ for (i = fad_sz - 1; i >= 0; --i) {
+ tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
+ hp += 3;
+ ret = CONS(hp, tpl, ret);
+ hp += 2;
+ }
+
+ return ret;
+}
+
+static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs)
{
- return binary_matches(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+ Eterm *hp;
+ Eterm ret;
+
+ if (bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)
+ && binary_size(subject) == 0) {
+ return NIL;
+ }
+ hp = HAlloc(p, 2);
+ ret = CONS(hp, subject, NIL);
+
+ return ret;
}
+static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ Sint pos, Sint len)
+{
+ size_t orig_size;
+ Eterm orig;
+ Uint offset;
+ Uint bit_offset;
+ Uint bit_size;
+ ErlSubBin *sb1;
+ ErlSubBin *sb2;
+ Eterm *hp;
+ Eterm ret;
+
+ orig_size = binary_size(subject);
+
+ if ((bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) &&
+ (orig_size - pos - len) == 0) {
+ if (pos == 0) {
+ ret = NIL;
+ } else {
+ hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+ ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+ sb1 = (ErlSubBin *) hp;
+ sb1->thing_word = HEADER_SUB_BIN;
+ sb1->size = pos;
+ sb1->offs = offset;
+ sb1->orig = orig;
+ sb1->bitoffs = bit_offset;
+ sb1->bitsize = bit_size;
+ sb1->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+
+ ret = CONS(hp, make_binary(sb1), NIL);
+ hp += 2;
+ }
+ } else {
+ if ((bfs->flags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
+ hp = HAlloc(p, 1 * (ERL_SUB_BIN_SIZE + 2));
+ ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+ sb1 = NULL;
+ } else {
+ hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
+ ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+ sb1 = (ErlSubBin *) hp;
+ sb1->thing_word = HEADER_SUB_BIN;
+ sb1->size = pos;
+ sb1->offs = offset;
+ sb1->orig = orig;
+ sb1->bitoffs = bit_offset;
+ sb1->bitsize = 0;
+ sb1->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+ }
+
+ sb2 = (ErlSubBin *) hp;
+ sb2->thing_word = HEADER_SUB_BIN;
+ sb2->size = orig_size - pos - len;
+ sb2->offs = offset + pos + len;
+ sb2->orig = orig;
+ sb2->bitoffs = bit_offset;
+ sb2->bitsize = bit_size;
+ sb2->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+
+ ret = CONS(hp, make_binary(sb2), NIL);
+ hp += 2;
+ if (sb1 != NULL) {
+ ret = CONS(hp, make_binary(sb1), ret);
+ hp += 2;
+ }
+ }
+ return ret;
+}
+
+static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ FindallData *fad, Uint fad_sz)
+{
+ size_t orig_size;
+ Eterm orig;
+ Uint offset;
+ Uint bit_offset;
+ Uint bit_size;
+ ErlSubBin *sb;
+ Sint i;
+ Sint tail;
+ Uint list_size;
+ Uint end_pos;
+ Uint do_trim = bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL);
+ Eterm *hp;
+ Eterm *hendp;
+ Eterm ret;
+
+ tail = fad_sz - 1;
+ list_size = fad_sz + 1;
+ orig_size = binary_size(subject);
+ end_pos = (Uint)(orig_size);
+
+ hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
+ hendp = hp + list_size * (ERL_SUB_BIN_SIZE + 2);
+ ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+ ASSERT(bit_size == 0);
+
+ ret = NIL;
+
+ for (i = tail; i >= 0; --i) {
+ sb = (ErlSubBin *)(hp);
+ sb->size = end_pos - (fad[i].pos + fad[i].len);
+ if (!(sb->size == 0 && do_trim)) {
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->offs = offset + fad[i].pos + fad[i].len;
+ sb->orig = orig;
+ sb->bitoffs = bit_offset;
+ sb->bitsize = 0;
+ sb->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+ ret = CONS(hp, make_binary(sb), ret);
+ hp += 2;
+ do_trim &= ~BINARY_SPLIT_TRIM;
+ }
+ end_pos = fad[i].pos;
+ }
+
+ sb = (ErlSubBin *)(hp);
+ sb->size = fad[0].pos;
+ if (!(sb->size == 0 && do_trim)) {
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->offs = offset;
+ sb->orig = orig;
+ sb->bitoffs = bit_offset;
+ sb->bitsize = 0;
+ sb->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+ ret = CONS(hp, make_binary(sb), ret);
+ hp += 2;
+ }
+ HRelease(p, hendp, hp);
+ return ret;
+}
+
+static BIF_RETTYPE binary_find_trap(BIF_ALIST_3)
+{
+ int runres;
+ Eterm result;
+ Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
+ runres = do_binary_find(BIF_P, BIF_ARG_1, NULL, bin, BIF_ARG_2, &result);
+ if (runres == DO_BIN_MATCH_OK) {
+ BIF_RET(result);
+ } else {
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP3(&binary_find_trap_export, BIF_P, BIF_ARG_1, result, BIF_ARG_3);
+ }
+}
BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen)
{
@@ -2550,7 +2790,6 @@ BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1)
}
pb = (ProcBin *) binary_val(bin);
if (pb->thing_word == HEADER_PROC_BIN) {
- /* XXX:PaN - Halfword - orig_size is a long, we should handle that */
res = erts_make_integer((Uint) pb->val->orig_size, BIF_P);
} else { /* heap binary */
res = erts_make_integer((Uint) ((ErlHeapBin *) pb)->size, BIF_P);
@@ -2568,7 +2807,7 @@ BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1)
#endif
static int get_need(Uint u) {
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (u > 0xFFFFFFFFUL) {
if (u > 0xFFFFFFFFFFFFUL) {
if (u > 0xFFFFFFFFFFFFFFUL) {
diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c
index 28bec6325c..2b1d875bfe 100644
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -1707,18 +1707,19 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type,
Eterm mess;
Eterm r;
Eterm *hp;
- ErlHeapFragment *bp;
- ErlOffHeap *ohp;
+ ErtsMessage *mp;
ErtsProcLocks rp_locks = 0;
+ ErlOffHeap *ohp;
ERTS_SMP_CHK_NO_PROC_LOCKS;
assert_drv_list_rwlocked();
if (errcode != 0) {
int need = load_error_need(errcode);
Eterm e;
- hp = erts_alloc_message_heap(6 /* tuple */ + 3 /* Error tuple */ +
- REF_THING_SIZE + need, &bp, &ohp,
- proc, &rp_locks);
+ mp = erts_alloc_message_heap(proc, &rp_locks,
+ (6 /* tuple */ + 3 /* Error tuple */ +
+ REF_THING_SIZE + need),
+ &hp, &ohp);
r = copy_ref(ref,hp);
hp += REF_THING_SIZE;
e = build_load_error_hp(hp, errcode);
@@ -1727,12 +1728,14 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type,
hp += 3;
mess = TUPLE5(hp,type,r,am_driver,driver_name,mess);
} else {
- hp = erts_alloc_message_heap(6 /* tuple */ + REF_THING_SIZE, &bp, &ohp, proc, &rp_locks);
+ mp = erts_alloc_message_heap(proc, &rp_locks,
+ 6 /* tuple */ + REF_THING_SIZE,
+ &hp, &ohp);
r = copy_ref(ref,hp);
hp += REF_THING_SIZE;
mess = TUPLE5(hp,type,r,am_driver,driver_name,tag);
}
- erts_queue_message(proc, &rp_locks, bp, mess, am_undefined);
+ erts_queue_message(proc, &rp_locks, mp, mess, am_undefined);
erts_smp_proc_unlock(proc, rp_locks);
ERTS_SMP_CHK_NO_PROC_LOCKS;
}
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 8bf6877bea..e4baff87f4 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -64,6 +64,7 @@ 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;
@@ -74,9 +75,6 @@ static char otp_version[] = ERLANG_OTP_VERSION;
static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
"%s"
" [erts-" ERLANG_VERSION "]"
-#if !HEAP_ON_C_STACK && !HALFWORD_HEAP
- " [no-c-stack-objects]"
-#endif
#ifndef OTP_RELEASE
#ifdef ERLANG_GIT_VERSION
" [source-" ERLANG_GIT_VERSION "]"
@@ -85,12 +83,8 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
#endif
#endif
#ifdef ARCH_64
-#if HALFWORD_HEAP
- " [64-bit halfword]"
-#else
" [64-bit]"
#endif
-#endif
#ifdef ERTS_SMP
" [smp:%beu:%beu]"
#endif
@@ -138,6 +132,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
#ifdef USE_SYSTEMTAP
" [systemtap]"
#endif
+#ifdef SHCOPY
+ " [sharing-preserving]"
+#endif
"\n");
#define ASIZE(a) (sizeof(a)/sizeof(a[0]))
@@ -597,6 +594,8 @@ static Eterm pi_args[] = {
am_min_bin_vheap_size,
am_current_location,
am_current_stacktrace,
+ am_message_queue_data,
+ am_garbage_collection_info
};
#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm)))
@@ -644,6 +643,8 @@ pi_arg2ix(Eterm arg)
case am_min_bin_vheap_size: return 28;
case am_current_location: return 29;
case am_current_stacktrace: return 30;
+ case am_message_queue_data: return 31;
+ case am_garbage_collection_info: return 32;
default: return -1;
}
}
@@ -672,18 +673,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;
@@ -732,9 +727,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);
@@ -825,10 +821,31 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
*fail_type = ERTS_PI_FAIL_TYPE_AWAIT_EXIT;
goto done;
}
- else if (!(locks & ERTS_PROC_LOCK_STATUS)) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+ else {
+ ErtsProcLocks unlock_locks = 0;
+
+ if (c_p == rp)
+ locks |= ERTS_PROC_LOCK_MAIN;
+
+ if (!(locks & ERTS_PROC_LOCK_STATUS))
+ unlock_locks |= ERTS_PROC_LOCK_STATUS;
+
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ /*
+ * Move in queue into private queue and
+ * release msgq lock, enabling others to
+ * send messages to the process while it
+ * is being inspected...
+ */
+ ASSERT(locks & ERTS_PROC_LOCK_MAIN);
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
+ locks &= ~ERTS_PROC_LOCK_MSGQ;
+ unlock_locks |= ERTS_PROC_LOCK_MSGQ;
+ }
+
+ if (unlock_locks)
+ erts_smp_proc_unlock(rp, unlock_locks);
}
-
/*
* We always handle 'messages' first if it should be part
@@ -840,7 +857,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);
}
@@ -848,7 +865,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);
}
}
@@ -979,9 +996,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));
@@ -999,6 +1038,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)
@@ -1070,171 +1110,55 @@ process_info_aux(Process *BIF_P,
break;
case am_messages: {
- ErlMessage* mp;
- int n;
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
- n = rp->msg.len;
-
- if (n == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) {
+ if (rp->msg.len == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) {
hp = HAlloc(BIF_P, 3);
} else {
- int remove_bad_messages = 0;
- struct {
- Uint copy_struct_size;
- ErlMessage* msgp;
- } *mq = erts_alloc(ERTS_ALC_T_TMP, n*sizeof(*mq));
- Sint i = 0;
- Uint heap_need = 3;
+ ErtsMessageInfo *mip;
+ Sint i;
+ Uint heap_need;
+#ifdef DEBUG
Eterm *hp_end;
+#endif
- for (mp = rp->msg.first; mp; mp = mp->next) {
- heap_need += 2;
- mq[i].msgp = mp;
- if (rp != BIF_P) {
- Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp);
- if (is_value(msg)) {
- mq[i].copy_struct_size = (is_immed(msg)? 0 :
- size_object(msg));
- }
- else if (mq[i].msgp->data.attached) {
- mq[i].copy_struct_size
- = erts_msg_attached_data_size(mq[i].msgp);
- }
- else {
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- mq[i].copy_struct_size = 0;
- }
- heap_need += mq[i].copy_struct_size;
- }
- else {
- mq[i].copy_struct_size = mp->data.attached ?
- erts_msg_attached_data_size(mp) : 0;
- }
- i++;
- }
+ mip = erts_alloc(ERTS_ALC_T_TMP,
+ rp->msg.len*sizeof(ErtsMessageInfo));
- if (rp != BIF_P) {
- hp = HAlloc(BIF_P, heap_need);
- hp_end = hp + heap_need;
- ASSERT(i == n);
- for (i--; i >= 0; i--) {
- Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp);
- if (is_value(msg)) {
- if (mq[i].copy_struct_size)
- msg = copy_struct(msg,
- mq[i].copy_struct_size,
- &hp,
- &MSO(BIF_P));
- }
- else if (mq[i].msgp->data.attached) {
- ErlHeapFragment *hfp;
- /*
- * Decode it into a message buffer and attach it
- * to the message instead of the attached external
- * term.
- *
- * Note that we may not pass a process pointer
- * to erts_msg_distext2heap(), since it would then
- * try to alter locks on that process.
- */
- msg = erts_msg_distext2heap(
- NULL, NULL, &hfp, &ERL_MESSAGE_TOKEN(mq[i].msgp),
- mq[i].msgp->data.dist_ext);
-
- ERL_MESSAGE_TERM(mq[i].msgp) = msg;
- mq[i].msgp->data.heap_frag = hfp;
-
- if (is_non_value(msg)) {
- ASSERT(!mq[i].msgp->data.heap_frag);
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- continue;
- }
- else {
- /* Make our copy of the message */
- ASSERT(size_object(msg) == erts_used_frag_sz(hfp));
- msg = copy_struct(msg,
- erts_used_frag_sz(hfp),
- &hp,
- &MSO(BIF_P));
- }
- }
- else {
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- continue;
- }
- res = CONS(hp, msg, res);
- hp += 2;
- }
- HRelease(BIF_P, hp_end, hp+3);
- }
- else {
- for (i--; i >= 0; i--) {
- ErtsHeapFactory factory;
- Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp);
-
- erts_factory_proc_prealloc_init(&factory, BIF_P,
- mq[i].copy_struct_size+2);
- if (mq[i].msgp->data.attached) {
- /* Decode it on the heap */
- erts_move_msg_attached_data_to_heap(&factory,
- mq[i].msgp);
- msg = ERL_MESSAGE_TERM(mq[i].msgp);
- ASSERT(!mq[i].msgp->data.attached);
- }
- if (is_value(msg)) {
- hp = erts_produce_heap(&factory, 2, 0);
- res = CONS(hp, msg, res);
- }
- else {
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- continue;
- }
- erts_factory_close(&factory);
- }
- hp = HAlloc(BIF_P, 3);
- }
- erts_free(ERTS_ALC_T_TMP, mq);
- if (remove_bad_messages) {
- ErlMessage **mpp;
- /*
- * We need to remove bad distribution messages from
- * the queue, so that the value returned for
- * 'message_queue_len' is consistent with the value
- * returned for 'messages'.
- */
- mpp = &rp->msg.first;
- mp = rp->msg.first;
- while (mp) {
- if (is_value(ERL_MESSAGE_TERM(mp))) {
- mpp = &mp->next;
- mp = mp->next;
- }
- else {
- ErlMessage* bad_mp = mp;
- ASSERT(!mp->data.attached);
- if (rp->msg.save == &mp->next)
- rp->msg.save = mpp;
- if (rp->msg.last == &mp->next)
- rp->msg.last = mpp;
- *mpp = mp->next;
- mp = mp->next;
- rp->msg.len--;
- free_message(bad_mp);
- }
- }
+ /*
+ * Note that message queue may shrink when calling
+ * erts_prep_msgq_for_inspection() since it removes
+ * corrupt distribution messages.
+ */
+ heap_need = erts_prep_msgq_for_inspection(BIF_P, rp, rp_locks, mip);
+ heap_need += 3; /* top 2-tuple */
+ heap_need += rp->msg.len*2; /* Cons cells */
+
+ hp = HAlloc(BIF_P, heap_need); /* heap_need is exact */
+#ifdef DEBUG
+ hp_end = hp + heap_need;
+#endif
+
+ /* Build list of messages... */
+ for (i = rp->msg.len - 1, res = NIL; i >= 0; i--) {
+ Eterm msg = ERL_MESSAGE_TERM(mip[i].msgp);
+ Uint sz = mip[i].size;
+
+ if (sz != 0)
+ msg = copy_struct(msg, sz, &hp, &BIF_P->off_heap);
+
+ res = CONS(hp, msg, res);
+ hp += 2;
}
+
+ ASSERT(hp_end == hp + 3);
+
+ erts_free(ERTS_ALC_T_TMP, mip);
}
break;
}
case am_message_queue_len:
hp = HAlloc(BIF_P, 3);
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
res = make_small(rp->msg.len);
break;
@@ -1422,7 +1346,7 @@ process_info_aux(Process *BIF_P,
}
case am_total_heap_size: {
- ErlMessage *mp;
+ ErtsMessage *mp;
Uint total_heap_size;
Uint hsz = 3;
@@ -1432,8 +1356,6 @@ process_info_aux(Process *BIF_P,
total_heap_size += rp->mbuf_sz;
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
-
for (mp = rp->msg.first; mp; mp = mp->next)
if (mp->data.attached)
total_heap_size += erts_msg_attached_data_size(mp);
@@ -1455,7 +1377,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);
@@ -1480,6 +1402,32 @@ process_info_aux(Process *BIF_P,
break;
}
+ case am_garbage_collection_info: {
+ Uint sz = 0, actual_sz = 0;
+
+ if (rp == BIF_P) {
+ sz += ERTS_PROCESS_GC_INFO_MAX_SIZE;
+ } else {
+ erts_process_gc_info(rp, &sz, NULL);
+ sz += 3;
+ }
+
+ hp = HAlloc(BIF_P, sz);
+ res = erts_process_gc_info(rp, &actual_sz, &hp);
+
+ /* We may have some extra space, fill with 0 tuples */
+ if (actual_sz <= sz - 3) {
+ for (; actual_sz < sz - 3; hp++, actual_sz++)
+ hp[0] = make_arityval(0);
+ } else {
+ for (; actual_sz < sz; hp++, actual_sz++)
+ hp[0] = make_arityval(0);
+ hp = HAlloc(BIF_P, 3);
+ }
+
+ break;
+ }
+
case am_group_leader: {
int sz = NC_HEAP_SIZE(rp->group_leader);
hp = HAlloc(BIF_P, 3 + sz);
@@ -1581,6 +1529,25 @@ process_info_aux(Process *BIF_P,
break;
}
+ case am_message_queue_data:
+ switch (rp->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) {
+ case F_OFF_HEAP_MSGQ:
+ res = am_off_heap;
+ break;
+ case F_ON_HEAP_MSGQ:
+ res = am_on_heap;
+ break;
+ case 0:
+ res = am_mixed;
+ break;
+ default:
+ res = am_error;
+ ERTS_INTERNAL_ERROR("Inconsistent message queue management state");
+ break;
+ }
+ hp = HAlloc(BIF_P, 3);
+ break;
+
default:
return THE_NON_VALUE; /* will produce badarg */
@@ -1755,7 +1722,7 @@ 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);
@@ -1774,7 +1741,7 @@ 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);
@@ -2742,6 +2709,19 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_true);
}
#endif
+ else if (BIF_ARG_1 == am_message_queue_data) {
+ switch (erts_default_spo_flags & (SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ)) {
+ case SPO_OFF_HEAP_MSGQ:
+ BIF_RET(am_off_heap);
+ case SPO_ON_HEAP_MSGQ:
+ BIF_RET(am_on_heap);
+ case 0:
+ BIF_RET(am_mixed);
+ default:
+ ERTS_INTERNAL_ERROR("Inconsistent message queue management state");
+ BIF_RET(am_error);
+ }
+ }
else if (ERTS_IS_ATOM_STR("compile_info",BIF_ARG_1)) {
Uint sz;
Eterm res = NIL, tup, text;
@@ -2780,6 +2760,20 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
else if (ERTS_IS_ATOM_STR("eager_check_io",BIF_ARG_1)) {
BIF_RET(erts_eager_check_io ? am_true : am_false);
}
+ else if (ERTS_IS_ATOM_STR("literal_test",BIF_ARG_1)) {
+#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
+#ifdef ARCH_64
+ DECL_AM(range);
+ BIF_RET(AM_range);
+#else /* ARCH_32 */
+ DECL_AM(range_bitmask);
+ BIF_RET(AM_range_bitmask);
+#endif /* ARCH_32 */
+#else /* ! ERTS_HAVE_IS_IN_LITERAL_RANGE */
+ DECL_AM(tag);
+ BIF_RET(AM_tag);
+#endif
+ }
BIF_ERROR(BIF_P, BADARG);
}
@@ -3268,6 +3262,14 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1)
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);
@@ -3488,7 +3490,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
BIF_RET(res);
}
else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) {
- BIF_RET(erts_mmap_debug_info(BIF_P));
+ BIF_RET(erts_mmap_debug_info(&erts_dflt_mmapper, BIF_P));
}
else if (ERTS_IS_ATOM_STR("unique_monotonic_integer_state", BIF_ARG_1)) {
BIF_RET(erts_debug_get_unique_monotonic_integer_state(BIF_P));
@@ -3910,9 +3912,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);
}
}
@@ -4131,6 +4131,17 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
BIF_RET(am_ok);
}
}
+ else if (ERTS_IS_ATOM_STR("fill_heap", BIF_ARG_1)) {
+ UWord left = HeapWordsLeft(BIF_P);
+ if (left > 1) {
+ Eterm* hp = HAlloc(BIF_P, left);
+ *hp = make_pos_bignum_header(left - 1);
+ }
+ if (BIF_ARG_2 == am_true) {
+ FLAGS(BIF_P) |= F_NEED_FULLSWEEP;
+ }
+ BIF_RET(am_ok);
+ }
}
BIF_ERROR(BIF_P, BADARG);
@@ -4380,14 +4391,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
@@ -4404,6 +4418,8 @@ erts_bif_info_init(void)
= erts_export_put(am_erlang, am_gather_gc_info_result, 1);
gather_io_bytes_trap
= erts_export_put(am_erts_internal, am_gather_io_bytes, 2);
+ gather_msacc_res_trap
+ = erts_export_put(am_erts_internal, am_gather_microstate_accounting_result, 2);
gather_system_check_res_trap
= erts_export_put(am_erts_internal, am_gather_system_check_result, 1);
process_info_init();
diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c
index 5583dcb371..fe64e76575 100644
--- a/erts/emulator/beam/erl_bif_lists.c
+++ b/erts/emulator/beam/erl_bif_lists.c
@@ -42,7 +42,7 @@ static BIF_RETTYPE append(Process* p, Eterm A, Eterm B)
Eterm last;
size_t need;
Eterm* hp;
- int i;
+ Sint i;
if ((i = erts_list_length(A)) < 0) {
BIF_ERROR(p, BADARG);
@@ -99,9 +99,9 @@ static Eterm subtract(Process* p, Eterm A, Eterm B)
Eterm small_vec[SMALL_VEC_SIZE]; /* Preallocated memory for small lists */
Eterm* vec_p;
Eterm* vp;
- int i;
- int n;
- int m;
+ Sint i;
+ Sint n;
+ Sint m;
if ((n = erts_list_length(A)) < 0) {
BIF_ERROR(p, BADARG);
diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c
index c9192fc420..0f20ded1d6 100644
--- a/erts/emulator/beam/erl_bif_op.c
+++ b/erts/emulator/beam/erl_bif_op.c
@@ -89,22 +89,22 @@ BIF_RETTYPE not_1(BIF_ALIST_1)
BIF_RETTYPE sgt_2(BIF_ALIST_2)
{
- BIF_RET(cmp_gt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_GT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE sge_2(BIF_ALIST_2)
{
- BIF_RET(cmp_ge(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_GE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE slt_2(BIF_ALIST_2)
{
- BIF_RET(cmp_lt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_LT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE sle_2(BIF_ALIST_2)
{
- BIF_RET(cmp_le(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_LE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE seq_2(BIF_ALIST_2)
@@ -114,7 +114,7 @@ BIF_RETTYPE seq_2(BIF_ALIST_2)
BIF_RETTYPE seqeq_2(BIF_ALIST_2)
{
- BIF_RET(cmp_eq(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_EQ(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE sneq_2(BIF_ALIST_2)
@@ -124,7 +124,7 @@ BIF_RETTYPE sneq_2(BIF_ALIST_2)
BIF_RETTYPE sneqeq_2(BIF_ALIST_2)
{
- BIF_RET(cmp_ne(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_NE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE is_atom_1(BIF_ALIST_1)
@@ -258,7 +258,7 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2)
BIF_RET(am_true);
}
} else if (is_export(arg1)) {
- Export* exp = (Export *) EXPAND_POINTER((export_val(arg1))[1]);
+ Export* exp = (Export *) (export_val(arg1)[1]);
if (exp->code[2] == (Uint) arity) {
BIF_RET(am_true);
diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c
index e47d7bcbbb..3acc1d7bbd 100644
--- a/erts/emulator/beam/erl_bif_port.c
+++ b/erts/emulator/beam/erl_bif_port.c
@@ -41,6 +41,7 @@
#include "external.h"
#include "packet_parser.h"
#include "erl_bits.h"
+#include "erl_bif_unique.h"
#include "dtrace-wrapper.h"
static Port *open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump);
@@ -50,10 +51,10 @@ static void free_args(char **);
char *erts_default_arg0 = "default";
-BIF_RETTYPE open_port_2(BIF_ALIST_2)
+BIF_RETTYPE erts_internal_open_port_2(BIF_ALIST_2)
{
Port *port;
- Eterm port_id;
+ Eterm res;
char *str;
int err_type, err_num;
@@ -61,27 +62,58 @@ BIF_RETTYPE open_port_2(BIF_ALIST_2)
if (!port) {
if (err_type == -3) {
ASSERT(err_num == BADARG || err_num == SYSTEM_LIMIT);
- BIF_ERROR(BIF_P, err_num);
+ if (err_num == BADARG)
+ res = am_badarg;
+ else if (err_num == SYSTEM_LIMIT)
+ res = am_system_limit;
+ else
+ /* this is only here to silence gcc, it should not happen */
+ BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
} else if (err_type == -2) {
str = erl_errno_id(err_num);
+ res = erts_atom_put((byte *) str, strlen(str), ERTS_ATOM_ENC_LATIN1, 1);
} else {
- str = "einval";
+ res = am_einval;
}
- BIF_P->fvalue = erts_atom_put((byte *) str, strlen(str), ERTS_ATOM_ENC_LATIN1, 1);
- BIF_ERROR(BIF_P, EXC_ERROR);
- }
+ BIF_RET(res);
+ }
+
+ if (port->drv_ptr->flags & ERL_DRV_FLAG_USE_INIT_ACK) {
+ /* Copied from erl_port_task.c */
+ port->async_open_port = erts_alloc(ERTS_ALC_T_PRTSD,
+ sizeof(*port->async_open_port));
+ erts_make_ref_in_array(port->async_open_port->ref);
+ port->async_open_port->to = BIF_P->common.id;
+
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK);
+ if (ERTS_PROC_PENDING_EXIT(BIF_P)) {
+ /* need to exit caller instead */
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK);
+ KILL_CATCHES(BIF_P);
+ BIF_P->freason = EXC_EXIT;
+ erts_port_release(port);
+ BIF_RET(am_badarg);
+ }
+
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(BIF_P);
+ BIF_P->msg.save = BIF_P->msg.last;
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE);
+
+ res = erts_proc_store_ref(BIF_P, port->async_open_port->ref);
+ } else {
+ res = port->common.id;
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
+ }
- port_id = port->common.id;
erts_add_link(&ERTS_P_LINKS(port), LINK_PID, BIF_P->common.id);
- erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port_id);
+ erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port->common.id);
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
erts_port_release(port);
- BIF_RET(port_id);
+ BIF_RET(res);
}
static ERTS_INLINE Port *
@@ -617,7 +649,7 @@ BIF_RETTYPE port_get_data_1(BIF_ALIST_1)
static Port *
open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
{
- int i;
+ Sint i;
Eterm option;
Uint arity;
Eterm* tp;
@@ -945,8 +977,8 @@ static char **convert_args(Eterm l)
{
char **pp;
char *b;
- int n;
- int i = 0;
+ Sint n;
+ Sint i = 0;
Eterm str;
if (is_not_list(l) && is_not_nil(l)) {
return NULL;
@@ -992,7 +1024,7 @@ static byte* convert_environment(Process* p, Eterm env)
Eterm* temp_heap;
Eterm* hp;
Uint heap_size;
- int n;
+ Sint n;
Sint size;
byte* bytes;
int encoding = erts_get_native_filename_encoding();
diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c
index 86951f32b0..7f7cd376ac 100644
--- a/erts/emulator/beam/erl_bif_re.c
+++ b/erts/emulator/beam/erl_bif_re.c
@@ -100,7 +100,7 @@ Sint erts_re_set_loop_limit(Sint limit)
static int term_to_int(Eterm term, int *sp)
{
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (is_small(term)) {
Uint x = signed_val(term);
@@ -151,7 +151,7 @@ static int term_to_int(Eterm term, int *sp)
static Eterm make_signed_integer(int x, Process *p)
{
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
return make_small(x);
#else
Eterm* hp;
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 08807d72c9..71a7079b09 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -1887,11 +1887,7 @@ new_seq_trace_token(Process* p)
{
Eterm* hp;
- if (SEQ_TRACE_TOKEN(p) == NIL
-#ifdef USE_VM_PROBES
- || SEQ_TRACE_TOKEN(p) == am_have_dt_utag
-#endif
- ) {
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) {
hp = HAlloc(p, 6);
SEQ_TRACE_TOKEN(p) = TUPLE5(hp, make_small(0), /* Flags */
make_small(0), /* Label */
@@ -1911,12 +1907,8 @@ 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) ||
+ 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)) {
@@ -1978,11 +1970,7 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1)
*/
BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1)
{
- if (SEQ_TRACE_TOKEN(BIF_P) == NIL
-#ifdef USE_VM_PROBES
- || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag
-#endif
- ) {
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) {
BIF_RET(am_false);
}
seq_trace_update_send(BIF_P);
@@ -2001,11 +1989,7 @@ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1)
*/
BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2)
{
- if (SEQ_TRACE_TOKEN(BIF_P) == NIL
-#ifdef USE_VM_PROBES
- || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag
-#endif
- ) {
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) {
BIF_RET(am_false);
}
if (!(is_atom(BIF_ARG_1) || is_small(BIF_ARG_1))) {
diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c
index 5eca09c5a6..c4a39b8897 100644
--- a/erts/emulator/beam/erl_bif_unique.c
+++ b/erts/emulator/beam/erl_bif_unique.c
@@ -338,7 +338,7 @@ static struct {
} w;
} raw_unique_monotonic_integer erts_align_attribute(ERTS_CACHE_LINE_SIZE);
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
# define ERTS_UNIQUE_MONOTONIC_OFFSET ERTS_SINT64_MIN
#else
# define ERTS_UNIQUE_MONOTONIC_OFFSET MIN_SMALL
@@ -368,7 +368,7 @@ get_unique_monotonic_integer_heap_size(Uint64 raw, int positive)
Sint64 value = ((Sint64) raw) + ERTS_UNIQUE_MONOTONIC_OFFSET;
if (IS_SSMALL(value))
return 0;
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
return ERTS_SINT64_HEAP_SIZE(value);
#else
return ERTS_UINT64_HEAP_SIZE((Uint64) value);
@@ -393,7 +393,7 @@ make_unique_monotonic_integer_value(Eterm *hp, Uint hsz, Uint64 raw, int positiv
if (hsz == 0)
res = make_small(value);
else {
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
res = erts_sint64_to_big(value, &hp);
#else
res = erts_uint64_to_big((Uint64) value, &hp);
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index ea01bf08f0..e181b5555d 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -72,7 +72,6 @@ typedef struct erl_heap_bin {
*/
#define binary_size(Bin) (binary_val(Bin)[1])
-#define binary_size_rel(Bin,BasePtr) (binary_val_rel(Bin,BasePtr)[1])
#define binary_bitsize(Bin) \
((*binary_val(Bin) == HEADER_SUB_BIN) ? \
@@ -95,12 +94,9 @@ typedef struct erl_heap_bin {
* Bitsize: output variable (Uint)
*/
-#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \
- ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,NULL)
-
-#define ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,BasePtr) \
+#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \
do { \
- Eterm* _real_bin = binary_val_rel(Bin,BasePtr); \
+ Eterm* _real_bin = binary_val(Bin); \
Uint _offs = 0; \
Bitoffs = Bitsize = 0; \
if (*_real_bin == HEADER_SUB_BIN) { \
@@ -108,7 +104,7 @@ do { \
_offs = _sb->offs; \
Bitoffs = _sb->bitoffs; \
Bitsize = _sb->bitsize; \
- _real_bin = binary_val_rel(_sb->orig,BasePtr); \
+ _real_bin = binary_val(_sb->orig); \
} \
if (*_real_bin == HEADER_PROC_BIN) { \
Bytep = ((ProcBin *) _real_bin)->bytes + _offs; \
@@ -131,11 +127,8 @@ do { \
*/
#define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \
- ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, NULL)
-
-#define ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, BasePtr) \
do { \
- ErlSubBin* _sb = (ErlSubBin *) binary_val_rel(Bin,BasePtr); \
+ ErlSubBin* _sb = (ErlSubBin *) binary_val(Bin); \
if (_sb->thing_word == HEADER_SUB_BIN) { \
RealBin = _sb->orig; \
ByteOffset = _sb->offs; \
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 01734c55d7..11d83686a3 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -282,7 +282,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
* Simply shift whole bytes into the result.
*/
switch (BYTE_OFFSET(n)) {
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
case 7: w = (w << 8) | *bp++;
case 6: w = (w << 8) | *bp++;
case 5: w = (w << 8) | *bp++;
@@ -387,7 +387,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
case 3:
v32 = LSB[0] + (LSB[1]<<8) + (LSB[2]<<16);
goto big_small;
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
case 4:
v32 = (LSB[0] + (LSB[1]<<8) + (LSB[2]<<16) + (LSB[3]<<24));
if (!IS_USMALL(sgn, v32)) {
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 645f9e3c28..55b8789e29 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -1773,15 +1773,9 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
* (it looks like an continuation pointer), but that is will crash the
* emulator if this BIF is call traced.
*/
-#if HALFWORD_HEAP
- Eterm *hp = HAlloc(BIF_P, 3);
- hp[0] = make_pos_bignum_header(2);
- *((UWord *) (UWord) (hp+1)) = (UWord) tb;
-#else
Eterm *hp = HAlloc(BIF_P, 2);
hp[0] = make_pos_bignum_header(1);
hp[1] = (Eterm) tb;
-#endif
BIF_TRAP1(&ets_delete_continue_exp, BIF_P, make_big(hp));
}
else {
@@ -1837,7 +1831,7 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3)
tb->common.id,
from_pid,
BIF_ARG_3),
- 0);
+ 0);
erts_smp_proc_unlock(to_proc, to_locks);
UnUseTmpHeap(5,BIF_P);
BIF_RET(am_true);
@@ -2839,7 +2833,7 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3)
BIF_TRAP3(bif_export[BIF_ets_match_spec_run_r_3],
BIF_P,lst,BIF_ARG_2,ret);
}
- res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, NULL, 0,
+ res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, 0,
ERTS_PAM_COPY_RESULT, &dummy);
if (is_value(res)) {
hp = HAlloc(BIF_P, 2);
@@ -3216,7 +3210,7 @@ retry:
tb->common.id,
p->common.id,
heir_data),
- 0);
+ 0);
erts_smp_proc_unlock(to_proc, to_locks);
return !0;
}
@@ -3651,11 +3645,8 @@ static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1)
Eterm* ptr = big_val(cont);
DbTable *tb = *((DbTable **) (UWord) (ptr + 1));
-#if HALFWORD_HEAP
- ASSERT(*ptr == make_pos_bignum_header(2));
-#else
ASSERT(*ptr == make_pos_bignum_header(1));
-#endif
+
db_lock(tb, LCK_WRITE);
trap = free_table_cont(p, tb, 0, 1);
db_unlock(tb, LCK_WRITE);
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index 98a2e2842a..cff65f244d 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -469,9 +469,6 @@ static ERTS_INLINE void try_shrink(DbTableHash* tb)
}
}
-#define EQ_REL(x,y,y_base) \
- (is_same(x,NULL,y,y_base) || (is_not_both_immed((x),(y)) && eq_rel((x),NULL,(y),y_base)))
-
/* Is this a live object (not pseodo-deleted) with the specified key?
*/
static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b,
@@ -481,7 +478,7 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b,
else {
Eterm itemKey = GETKEY(tb, b->dbterm.tpl);
ASSERT(!is_header(itemKey));
- return EQ_REL(key, itemKey, b->dbterm.tpl);
+ return EQ(key, itemKey);
}
}
@@ -494,7 +491,7 @@ static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b,
else {
Eterm itemKey = GETKEY(tb, b->dbterm.tpl);
ASSERT(!is_header(itemKey));
- return EQ_REL(key, itemKey, b->dbterm.tpl);
+ return EQ(key, itemKey);
}
}
@@ -2204,11 +2201,11 @@ static void db_print_hash(int to, void *to_arg, int show, DbTable *tbl)
erts_print(to, to_arg, "*");
if (tb->common.compress) {
Eterm key = GETKEY(tb, list->dbterm.tpl);
- erts_print(to, to_arg, "key=%R", key, list->dbterm.tpl);
+ erts_print(to, to_arg, "key=%T", key);
}
else {
- Eterm obj = make_tuple_rel(list->dbterm.tpl,list->dbterm.tpl);
- erts_print(to, to_arg, "%R", obj, list->dbterm.tpl);
+ Eterm obj = make_tuple(list->dbterm.tpl);
+ erts_print(to, to_arg, "%T", obj);
}
if (list->next != 0)
erts_print(to, to_arg, ",");
@@ -2899,9 +2896,6 @@ Ldone:
handle->dbterm = &b->dbterm;
handle->flags = flags;
handle->new_size = b->dbterm.size;
-#if HALFWORD_HEAP
- handle->abs_vec = NULL;
-#endif
handle->lck = lck;
return 1;
}
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index 465aa566ad..311b69d114 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -280,7 +280,7 @@ struct select_delete_context {
/*
** Forward declarations
*/
-static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key, Eterm* key_base);
+static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key);
static TreeDbTerm *linkout_object_tree(DbTableTree *tb,
Eterm object);
static int do_free_tree_cont(DbTableTree *tb, int num_left);
@@ -291,15 +291,15 @@ static int delsub(TreeDbTerm **this);
static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot);
static TreeDbTerm *find_node(DbTableTree *tb, Eterm key);
static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key);
-static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase);
-static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase);
+static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key);
+static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key);
static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack*,
Eterm key);
static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack*,
Eterm key);
static void traverse_backwards(DbTableTree *tb,
DbTreeStack*,
- Eterm lastkey, Eterm* lk_base,
+ Eterm lastkey,
int (*doit)(DbTableTree *tb,
TreeDbTerm *,
void *,
@@ -307,7 +307,7 @@ static void traverse_backwards(DbTableTree *tb,
void *context);
static void traverse_forward(DbTableTree *tb,
DbTreeStack*,
- Eterm lastkey, Eterm* lk_base,
+ Eterm lastkey,
int (*doit)(DbTableTree *tb,
TreeDbTerm *,
void *,
@@ -315,8 +315,8 @@ static void traverse_forward(DbTableTree *tb,
void *context);
static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
Eterm *partly_bound_key);
-static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base);
-static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done);
+static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key);
+static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done);
static int analyze_pattern(DbTableTree *tb, Eterm pattern,
struct mp_info *mpi);
@@ -517,7 +517,7 @@ static int db_next_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
if (is_atom(key) && key == am_EOT)
return DB_ERROR_BADKEY;
stack = get_any_stack(tb);
- this = find_next(tb, stack, key, NULL);
+ this = find_next(tb, stack, key);
release_stack(tb,stack);
if (this == NULL) {
*ret = am_EOT;
@@ -563,7 +563,7 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
if (is_atom(key) && key == am_EOT)
return DB_ERROR_BADKEY;
stack = get_any_stack(tb);
- this = find_prev(tb, stack, key, NULL);
+ this = find_prev(tb, stack, key);
release_stack(tb,stack);
if (this == NULL) {
*ret = am_EOT;
@@ -573,19 +573,13 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
return DB_ERROR_NONE;
}
-static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base,
- TreeDbTerm* obj)
-{
- return cmp_rel(key, key_base,
- GETKEY(tb,obj->dbterm.tpl), obj->dbterm.tpl);
+static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, TreeDbTerm* obj) {
+ return CMP(key, GETKEY(tb,obj->dbterm.tpl));
}
-static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base,
- TreeDbTerm* obj)
-{
+static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, TreeDbTerm* obj) {
Eterm obj_key = GETKEY(tb,obj->dbterm.tpl);
- return is_same(key, key_base, obj_key, obj->dbterm.tpl)
- || cmp_rel(key, key_base, obj_key, obj->dbterm.tpl) == 0;
+ return is_same(key, obj_key) || CMP(key, obj_key) == 0;
}
static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail)
@@ -619,7 +613,7 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail)
(*this)->balance = 0;
(*this)->left = (*this)->right = NULL;
break;
- } else if ((c = cmp_key(tb, key, NULL, *this)) < 0) {
+ } else if ((c = cmp_key(tb, key, *this)) < 0) {
/* go lefts */
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
@@ -774,7 +768,7 @@ static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret)
*ret = am_true;
- if ((res = linkout_tree(tb, key, NULL)) != NULL) {
+ if ((res = linkout_tree(tb, key)) != NULL) {
free_term(tb, res);
}
return DB_ERROR_NONE;
@@ -970,15 +964,15 @@ static int db_select_continue_tree(Process *p,
stack = get_any_stack(tb);
if (chunk_size) {
if (reverse) {
- traverse_backwards(tb, stack, lastkey, NULL, &doit_select_chunk, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc);
} else {
- traverse_forward(tb, stack, lastkey, NULL, &doit_select_chunk, &sc);
+ traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc);
}
} else {
if (reverse) {
- traverse_forward(tb, stack, lastkey, NULL, &doit_select, &sc);
+ traverse_forward(tb, stack, lastkey, &doit_select, &sc);
} else {
- traverse_backwards(tb, stack, lastkey, NULL, &doit_select, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select, &sc);
}
}
release_stack(tb,stack);
@@ -1003,9 +997,9 @@ static int db_select_continue_tree(Process *p,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key,sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
continuation = TUPLE8
(hp,
tptr[1],
@@ -1026,8 +1020,8 @@ static int db_select_continue_tree(Process *p,
key = GETKEY(tb, sc.lastobj);
if (chunk_size) {
if (end_condition != NIL &&
- ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0) ||
- (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0))) {
+ ((!reverse && cmp_partly_bound(end_condition,key) < 0) ||
+ (reverse && cmp_partly_bound(end_condition,key) > 0))) {
/* done anyway */
if (!sc.got) {
RET_TO_BIF(am_EOT, DB_ERROR_NONE);
@@ -1039,16 +1033,16 @@ static int db_select_continue_tree(Process *p,
}
} else {
if (end_condition != NIL &&
- ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0) ||
- (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0))) {
+ ((!reverse && cmp_partly_bound(end_condition,key) > 0) ||
+ (reverse && cmp_partly_bound(end_condition,key) < 0))) {
/* done anyway */
RET_TO_BIF(sc.accum,DB_ERROR_NONE);
}
}
/* Not done yet, let's trap. */
- sz = size_object_rel(key,sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
continuation = TUPLE8
(hp,
tptr[1],
@@ -1075,7 +1069,6 @@ static int db_select_tree(Process *p, DbTable *tbl,
struct select_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
- Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1127,20 +1120,18 @@ static int db_select_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.most;
}
- traverse_forward(tb, stack, lastkey, lk_base, &doit_select, &sc);
+ traverse_forward(tb, stack, lastkey, &doit_select, &sc);
} else {
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, stack, lastkey, lk_base, &doit_select, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select, &sc);
}
release_stack(tb,stack);
#ifdef HARDDEBUG
@@ -1153,9 +1144,9 @@ static int db_select_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
mpb=db_make_mp_binary(p,mpi.mp,&hp);
@@ -1236,7 +1227,7 @@ static int db_select_count_continue_tree(Process *p,
}
stack = get_any_stack(tb);
- traverse_backwards(tb, stack, lastkey, NULL, &doit_select_count, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc);
release_stack(tb,stack);
BUMP_REDS(p, 1000 - sc.max);
@@ -1246,12 +1237,12 @@ static int db_select_count_continue_tree(Process *p,
}
key = GETKEY(tb, sc.lastobj);
if (end_condition != NIL &&
- (cmp_partly_bound(end_condition,key,sc.lastobj) > 0)) {
+ (cmp_partly_bound(end_condition,key) > 0)) {
/* done anyway */
RET_TO_BIF(make_small(sc.got),DB_ERROR_NONE);
}
/* Not done yet, let's trap. */
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
if (IS_USMALL(0, sc.got)) {
hp = HAlloc(p, sz + 6);
egot = make_small(sc.got);
@@ -1261,7 +1252,7 @@ static int db_select_count_continue_tree(Process *p,
egot = uint_to_big(sc.got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
continuation = TUPLE5
(hp,
tptr[1],
@@ -1284,7 +1275,6 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
struct select_count_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
- Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1334,12 +1324,11 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_count, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc);
release_stack(tb,stack);
BUMP_REDS(p, 1000 - sc.max);
if (sc.max > 0) {
@@ -1347,7 +1336,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
if (IS_USMALL(0, sc.got)) {
hp = HAlloc(p, sz + PROC_BIN_SIZE + 6);
egot = make_small(sc.got);
@@ -1357,7 +1346,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
egot = uint_to_big(sc.got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
mpb = db_make_mp_binary(p,mpi.mp,&hp);
@@ -1388,7 +1377,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
struct select_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
- Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1445,20 +1433,18 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc);
} else {
if (mpi.some_limitation) {
if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.most;
}
- traverse_forward(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc);
+ traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc);
}
release_stack(tb,stack);
@@ -1483,9 +1469,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
mpb = db_make_mp_binary(p,mpi.mp,&hp);
@@ -1508,9 +1494,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
@@ -1586,7 +1572,7 @@ static int db_select_delete_continue_tree(Process *p,
sc.keypos = tb->common.keypos;
ASSERT(!erts_smp_atomic_read_nob(&tb->is_stack_busy));
- traverse_backwards(tb, &tb->static_stack, lastkey, NULL, &doit_select_delete, &sc);
+ traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc);
BUMP_REDS(p, 1000 - sc.max);
@@ -1595,11 +1581,11 @@ static int db_select_delete_continue_tree(Process *p,
}
key = GETKEY(tb, (sc.lastterm)->dbterm.tpl);
if (end_condition != NIL &&
- cmp_partly_bound(end_condition,key,sc.lastterm->dbterm.tpl) > 0) { /* done anyway */
+ cmp_partly_bound(end_condition,key) > 0) { /* done anyway */
RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE);
}
/* Not done yet, let's trap. */
- sz = size_object_rel(key, sc.lastterm->dbterm.tpl);
+ sz = size_object(key);
if (IS_USMALL(0, sc.accum)) {
hp = HAlloc(p, sz + 6);
eaccsum = make_small(sc.accum);
@@ -1609,7 +1595,7 @@ static int db_select_delete_continue_tree(Process *p,
eaccsum = uint_to_big(sc.accum, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
continuation = TUPLE5
(hp,
tptr[1],
@@ -1630,7 +1616,6 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
struct select_delete_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
- Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1683,12 +1668,11 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, &tb->static_stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, &tb->static_stack, lastkey, lk_base, &doit_select_delete, &sc);
+ traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc);
BUMP_REDS(p, 1000 - sc.max);
if (sc.max > 0) {
@@ -1696,7 +1680,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, (sc.lastterm)->dbterm.tpl);
- sz = size_object_rel(key, sc.lastterm->dbterm.tpl);
+ sz = size_object(key);
if (IS_USMALL(0, sc.accum)) {
hp = HAlloc(p, sz + PROC_BIN_SIZE + 6);
eaccsum = make_small(sc.accum);
@@ -1706,7 +1690,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
eaccsum = uint_to_big(sc.accum, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
mpb = db_make_mp_binary(p,mpi.mp,&hp);
continuation = TUPLE5
@@ -1734,7 +1718,7 @@ static int db_take_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
TreeDbTerm *this;
*ret = NIL;
- this = linkout_tree(tb, key, NULL);
+ this = linkout_tree(tb, key);
if (this) {
Eterm copy, *hp, *hend;
@@ -1845,9 +1829,7 @@ do_db_tree_foreach_offheap(TreeDbTerm *tdbt,
do_db_tree_foreach_offheap(tdbt->right, func, arg);
}
-static TreeDbTerm *linkout_tree(DbTableTree *tb,
- Eterm key, Eterm* key_base)
-{
+static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key) {
TreeDbTerm **tstack[STACK_NEED];
int tpos = 0;
int dstack[STACK_NEED+1];
@@ -1869,7 +1851,7 @@ static TreeDbTerm *linkout_tree(DbTableTree *tb,
for (;;) {
if (!*this) { /* Failure */
return NULL;
- } else if ((c = cmp_key(tb, key, key_base, *this)) < 0) {
+ } else if ((c = cmp_key(tb, key, *this)) < 0) {
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
this = &((*this)->left);
@@ -1933,7 +1915,7 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb,
for (;;) {
if (!*this) { /* Failure */
return NULL;
- } else if ((c = cmp_key(tb,key,NULL,*this)) < 0) {
+ } else if ((c = cmp_key(tb,key,*this)) < 0) {
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
this = &((*this)->left);
@@ -2319,15 +2301,13 @@ done:
* Find next and previous in sort order
*/
-static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack,
- Eterm key, Eterm* key_base)
-{
+static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) {
TreeDbTerm *this;
TreeDbTerm *tmp;
Sint c;
if(( this = TOP_NODE(stack)) != NULL) {
- if (!cmp_key_eq(tb,key,key_base,this)) {
+ if (!cmp_key_eq(tb,key,this)) {
/* Start from the beginning */
stack->pos = stack->slot = 0;
}
@@ -2337,7 +2317,7 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_key(tb,key,key_base,this) ) > 0) {
+ if (( c = cmp_key(tb,key,this) ) > 0) {
if (this->right == NULL) /* We are at the previos
and the element does
not exist */
@@ -2377,15 +2357,13 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack,
return this;
}
-static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack,
- Eterm key, Eterm* key_base)
-{
+static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key) {
TreeDbTerm *this;
TreeDbTerm *tmp;
Sint c;
if(( this = TOP_NODE(stack)) != NULL) {
- if (!cmp_key_eq(tb,key,key_base,this)) {
+ if (!cmp_key_eq(tb,key,this)) {
/* Start from the beginning */
stack->pos = stack->slot = 0;
}
@@ -2395,7 +2373,7 @@ static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_key(tb,key,key_base,this) ) < 0) {
+ if (( c = cmp_key(tb,key,this) ) < 0) {
if (this->left == NULL) /* We are at the next
and the element does
not exist */
@@ -2448,8 +2426,7 @@ static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl),
- this->dbterm.tpl) ) >= 0) {
+ if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl))) >= 0) {
if (this->right == NULL) {
do {
tmp = POP_NODE(stack);
@@ -2482,8 +2459,7 @@ static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl),
- this->dbterm.tpl) ) <= 0) {
+ if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl))) <= 0) {
if (this->left == NULL) {
do {
tmp = POP_NODE(stack);
@@ -2514,10 +2490,10 @@ static TreeDbTerm *find_node(DbTableTree *tb, Eterm key)
DbTreeStack* stack = get_static_stack(tb);
if(!stack || EMPTY_NODE(stack)
- || !cmp_key_eq(tb, key, NULL, (this=TOP_NODE(stack)))) {
+ || !cmp_key_eq(tb, key, (this=TOP_NODE(stack)))) {
this = tb->root;
- while (this != NULL && (res = cmp_key(tb,key,NULL,this)) != 0) {
+ while (this != NULL && (res = cmp_key(tb,key,this)) != 0) {
if (res < 0)
this = this->left;
else
@@ -2539,7 +2515,7 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key)
Sint res;
this = &tb->root;
- while ((*this) != NULL && (res = cmp_key(tb, key, NULL, *this)) != 0) {
+ while ((*this) != NULL && (res = cmp_key(tb, key, *this)) != 0) {
if (res < 0)
this = &((*this)->left);
else
@@ -2589,9 +2565,6 @@ db_lookup_dbterm_tree(Process *p, DbTable *tbl, Eterm key, Eterm obj,
handle->flags = flags;
handle->bp = (void**) pp;
handle->new_size = (*pp)->dbterm.size;
-#if HALFWORD_HEAP
- handle->abs_vec = NULL;
-#endif
return 1;
}
@@ -2622,7 +2595,7 @@ db_finalize_dbterm_tree(int cret, DbUpdateHandle *handle)
*/
static void traverse_backwards(DbTableTree *tb,
DbTreeStack* stack,
- Eterm lastkey, Eterm* lk_base,
+ Eterm lastkey,
int (*doit)(DbTableTree *,
TreeDbTerm *,
void *,
@@ -2641,16 +2614,15 @@ static void traverse_backwards(DbTableTree *tb,
this = this->right;
}
this = TOP_NODE(stack);
- next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl),
- this->dbterm.tpl);
+ next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl));
if (!((*doit)(tb, this, context, 0)))
return;
} else {
- next = find_prev(tb, stack, lastkey, lk_base);
+ next = find_prev(tb, stack, lastkey);
}
while ((this = next) != NULL) {
- next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl);
+ next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl));
if (!((*doit)(tb, this, context, 0)))
return;
}
@@ -2661,7 +2633,7 @@ static void traverse_backwards(DbTableTree *tb,
*/
static void traverse_forward(DbTableTree *tb,
DbTreeStack* stack,
- Eterm lastkey, Eterm* lk_base,
+ Eterm lastkey,
int (*doit)(DbTableTree *,
TreeDbTerm *,
void *,
@@ -2680,15 +2652,15 @@ static void traverse_forward(DbTableTree *tb,
this = this->left;
}
this = TOP_NODE(stack);
- next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl);
+ next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl));
if (!((*doit)(tb, this, context, 1)))
return;
} else {
- next = find_next(tb, stack, lastkey, lk_base);
+ next = find_next(tb, stack, lastkey);
}
while ((this = next) != NULL) {
- next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl);
+ next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl));
if (!((*doit)(tb, this, context, 1)))
return;
}
@@ -2725,7 +2697,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
-static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done)
+static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done)
{
Eterm* aa;
Eterm* bb;
@@ -2739,44 +2711,44 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done)
*done = 1;
return 0;
}
- if (is_same(a,NULL,b,b_base))
+ if (is_same(a,b))
return 0;
switch (a & _TAG_PRIMARY_MASK) {
case TAG_PRIMARY_LIST:
if (!is_list(b)) {
- return cmp_rel(a,NULL,b,b_base);
+ return CMP(a,b);
}
aa = list_val(a);
- bb = list_val_rel(b,b_base);
+ bb = list_val(b);
while (1) {
- if ((j = do_cmp_partly_bound(*aa++, *bb++, b_base, done)) != 0 || *done)
+ if ((j = do_cmp_partly_bound(*aa++, *bb++, done)) != 0 || *done)
return j;
- if (is_same(*aa, NULL, *bb, b_base))
+ if (is_same(*aa, *bb))
return 0;
if (is_not_list(*aa) || is_not_list(*bb))
- return do_cmp_partly_bound(*aa, *bb, b_base, done);
+ return do_cmp_partly_bound(*aa, *bb, done);
aa = list_val(*aa);
- bb = list_val_rel(*bb,b_base);
+ bb = list_val(*bb);
}
case TAG_PRIMARY_BOXED:
if ((b & _TAG_PRIMARY_MASK) != TAG_PRIMARY_BOXED) {
- return cmp_rel(a,NULL,b,b_base);
+ return CMP(a,b);
}
a_hdr = ((*boxed_val(a)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE;
- b_hdr = ((*boxed_val_rel(b,b_base)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE;
+ b_hdr = ((*boxed_val(b)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE;
if (a_hdr != b_hdr) {
- return cmp_rel(a, NULL, b, b_base);
+ return CMP(a,b);
}
if (a_hdr == (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) {
aa = tuple_val(a);
- bb = tuple_val_rel(b, b_base);
+ bb = tuple_val(b);
/* compare the arities */
i = arityval(*aa); /* get the arity*/
if (i < arityval(*bb)) return(-1);
if (i > arityval(*bb)) return(1);
while (i--) {
- if ((j = do_cmp_partly_bound(*++aa, *++bb, b_base, done)) != 0
+ if ((j = do_cmp_partly_bound(*++aa, *++bb, done)) != 0
|| *done)
return j;
}
@@ -2784,14 +2756,13 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done)
}
/* Drop through */
default:
- return cmp_rel(a, NULL, b, b_base);
+ return CMP(a,b);
}
}
-static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base)
-{
+static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key) {
int done = 0;
- Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, bk_base, &done);
+ Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, &done);
#ifdef HARDDEBUG
erts_fprintf(stderr,"\ncmp_partly_bound: %T", partly_bound_key);
if (ret < 0)
@@ -2800,7 +2771,7 @@ static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_
erts_fprintf(stderr," > ");
else
erts_fprintf(stderr," == ");
- erts_fprintf(stderr,"%R\n", bound_key, bk_base);
+ erts_fprintf(stderr,"%T\n", bound_key);
#endif
return ret;
}
@@ -3017,12 +2988,10 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr,
if (sc->end_condition != NIL &&
((forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) < 0) ||
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) < 0) ||
(!forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) > 0))) {
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) {
return 0;
}
ret = db_match_dbterm(&tb->common,sc->p,sc->mp,sc->all_objects,
@@ -3054,8 +3023,7 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr,
/* Always backwards traversing */
if (sc->end_condition != NIL &&
(cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) > 0)) {
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0)) {
return 0;
}
ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0,
@@ -3081,12 +3049,10 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr,
if (sc->end_condition != NIL &&
((forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) < 0) ||
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) < 0) ||
(!forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) > 0))) {
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) {
return 0;
}
@@ -3124,14 +3090,13 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr,
if (sc->end_condition != NIL &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) > 0)
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0)
return 0;
ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0,
&this->dbterm, NULL, 0);
if (ret == am_true) {
key = GETKEY(sc->tb, this->dbterm.tpl);
- linkout_tree(sc->tb, key, this->dbterm.tpl);
+ linkout_tree(sc->tb, key);
sc->erase_lastterm = 1;
++sc->accum;
}
@@ -3157,11 +3122,10 @@ static void do_dump_tree2(DbTableTree* tb, int to, void *to_arg, int show,
}
else {
prefix = "";
- term = make_tuple_rel(t->dbterm.tpl,t->dbterm.tpl);
+ term = make_tuple(t->dbterm.tpl);
}
- erts_print(to, to_arg, "%*s%s%R (addr = %p, bal = %d)\n",
- offset, "", prefix, term, t->dbterm.tpl,
- t, t->balance);
+ erts_print(to, to_arg, "%*s%s%T (addr = %p, bal = %d)\n",
+ offset, "", prefix, term, t, t->balance);
}
do_dump_tree2(tb, to, to_arg, show, t->left, offset + 4);
}
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index dab357a079..399be6058c 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -239,11 +239,7 @@ typedef enum {
matchCall2,
matchCall3,
matchPushV,
-#if HALFWORD_HEAP
- matchPushVGuard, /* First guard-only variable reference */
-#endif
- matchPushVResult, /* First variable reference in result, or (if HALFWORD)
- in guard if also referenced in result */
+ matchPushVResult, /* First variable reference in result */
matchPushExpr, /* Push the whole expression we're matching ('$_') */
matchPushArrayAsList, /* Only when parameter is an Array and
not an erlang term (DCOMP_TRACE) */
@@ -310,9 +306,6 @@ DMC_DECLARE_STACK_TYPE(unsigned);
typedef struct DMCVariable {
int is_bound;
int is_in_body;
-#if HALFWORD_HEAP
- int first_guard_label; /* to maybe change from PushVGuard to PushVResult */
-#endif
} DMCVariable;
typedef struct DMCHeap {
@@ -374,7 +367,6 @@ typedef struct MatchVariable {
Eterm term;
#ifdef DEBUG
Process* proc;
- Eterm* base;
#endif
} MatchVariable;
@@ -415,7 +407,7 @@ cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap)
else {
int i;
for (i = 0; i < ERTS_DEFAULT_MS_HEAP_SIZE; i++) {
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
mpsp->default_heap[i] = (Eterm) 0xdeadbeefdeadbeef;
#else
mpsp->default_heap[i] = (Eterm) 0xdeadbeef;
@@ -1240,7 +1232,7 @@ Eterm erts_match_set_run(Process *p, Binary *mpsp,
{
Eterm ret;
- ret = db_prog_match(p, mpsp, NIL, NULL, args, num_args,
+ ret = db_prog_match(p, mpsp, NIL, args, num_args,
in_flags, return_flags);
#if defined(HARDDEBUG)
if (is_non_value(ret)) {
@@ -1265,7 +1257,7 @@ static Eterm erts_match_set_run_ets(Process *p, Binary *mpsp,
{
Eterm ret;
- ret = db_prog_match(p, mpsp, args, NULL, NULL, num_args,
+ ret = db_prog_match(p, mpsp, args, NULL, num_args,
ERTS_PAM_COPY_RESULT,
return_flags);
#if defined(HARDDEBUG)
@@ -1755,71 +1747,6 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity)
return ret;
}
-
-#if HALFWORD_HEAP
-struct heap_checkpoint_t
-{
- Process *p;
- Eterm* htop;
- ErlHeapFragment* mbuf;
- unsigned used_size;
- ErlOffHeap off_heap;
-};
-
-static void heap_checkpoint_init(Process* p, struct heap_checkpoint_t* hcp)
-{
- hcp->p = p;
- hcp->htop = HEAP_TOP(p);
- hcp->mbuf = MBUF(p);
- hcp->used_size = hcp->mbuf ? hcp->mbuf->used_size : 0;
- hcp->off_heap = MSO(p);
-}
-
-static void heap_checkpoint_revert(struct heap_checkpoint_t* hcp)
-{
- struct erl_off_heap_header* oh = MSO(hcp->p).first;
-
- if (oh != hcp->off_heap.first) {
- ASSERT(oh != NULL);
- if (hcp->off_heap.first) {
- while (oh->next != hcp->off_heap.first) {
- oh = oh->next;
- }
- oh->next = NULL;
- }
- erts_cleanup_offheap(&MSO(hcp->p));
- MSO(hcp->p) = hcp->off_heap;
- }
- if (MBUF(hcp->p) != hcp->mbuf) {
- ErlHeapFragment* hf = MBUF(hcp->p);
- ASSERT(hf != NULL);
- if (hcp->mbuf) {
- while (hf->next != hcp->mbuf) {
- hf = hf->next;
- }
- hf->next = NULL;
- }
- free_message_buffer(MBUF(hcp->p));
- MBUF(hcp->p) = hcp->mbuf;
- }
- if (hcp->mbuf != NULL && hcp->mbuf->used_size != hcp->used_size) {
- hcp->mbuf->used_size = hcp->used_size;
- }
- HEAP_TOP(hcp->p) = hcp->htop;
-}
-#endif /* HALFWORD_HEAP */
-
-static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base)
-{
- if (!is_immed(term)) {
- Uint sz = size_object_rel(term, base);
- Eterm* top = HAllocX(p, sz, HEAP_XTRA);
- return copy_struct_rel(term, sz, &top, &MSO(p), base, NULL);
- }
- return term;
-}
-
-
/*
** Execution of the match program, this is Pam.
** May return THE_NON_VALUE, which is a bailout.
@@ -1827,7 +1754,7 @@ static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base)
** i.e. 'DCOMP_TRACE' was specified
*/
Eterm db_prog_match(Process *c_p, Binary *bprog,
- Eterm term, Eterm* base,
+ Eterm term,
Eterm *termp,
int arity,
enum erts_pam_run_flags in_flags,
@@ -1855,17 +1782,12 @@ Eterm db_prog_match(Process *c_p, Binary *bprog,
Eterm bif_args[3];
int fail_label;
int atomic_trace;
-#if HALFWORD_HEAP
- struct heap_checkpoint_t c_p_checkpoint = {};
-#endif
#ifdef DMC_DEBUG
Uint *heap_fence;
Uint *stack_fence;
Uint save_op;
#endif /* DMC_DEBUG */
- ASSERT(base==NULL || HALFWORD_HEAP);
-
mpsp = get_match_pseudo_process(c_p, prog->heap_size);
psp = &mpsp->process;
@@ -1916,11 +1838,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog,
do_catch != 0 */
*return_flags = 0U;
-
variables = mpsp->u.variables;
-#if HALFWORD_HEAP
- c_p_checkpoint.p = NULL;
-#endif
restart:
ep = &term;
@@ -1931,14 +1849,12 @@ restart:
fail_label = -1;
build_proc = psp;
esdp->current_process = psp;
- ASSERT_HALFWORD(!c_p_checkpoint.p);
#ifdef DEBUG
ASSERT(variables == mpsp->u.variables);
for (i=0; i<prog->num_bindings; i++) {
variables[i].term = THE_NON_VALUE;
variables[i].proc = NULL;
- variables[i].base = base;
}
#endif
@@ -1974,9 +1890,9 @@ restart:
variables[n].term = dpm_array_to_list(psp, termp, arity);
break;
case matchTuple: /* *ep is a tuple of arity n */
- if (!is_tuple_rel(*ep,base))
+ if (!is_tuple(*ep))
FAIL();
- ep = tuple_val_rel(*ep,base);
+ ep = tuple_val(*ep);
n = *pc++;
if (arityval(*ep) != n)
FAIL();
@@ -1984,9 +1900,9 @@ restart:
break;
case matchPushT: /* *ep is a tuple of arity n,
push ptr to first element */
- if (!is_tuple_rel(*ep,base))
+ if (!is_tuple(*ep))
FAIL();
- tp = tuple_val_rel(*ep,base);
+ tp = tuple_val(*ep);
n = *pc++;
if (arityval(*tp) != n)
FAIL();
@@ -1996,51 +1912,51 @@ restart:
case matchList:
if (!is_list(*ep))
FAIL();
- ep = list_val_rel(*ep,base);
+ ep = list_val(*ep);
break;
case matchPushL:
if (!is_list(*ep))
FAIL();
- *sp++ = list_val_rel(*ep,base);
+ *sp++ = list_val(*ep);
++ep;
break;
case matchMap:
- if (!is_map_rel(*ep, base)) {
+ if (!is_map(*ep)) {
FAIL();
}
n = *pc++;
- if (is_flatmap_rel(*ep,base)) {
- if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) {
+ if (is_flatmap(*ep)) {
+ if (flatmap_get_size(flatmap_val(*ep)) < n) {
FAIL();
}
} else {
- ASSERT(is_hashmap_rel(*ep,base));
- if (hashmap_size_rel(*ep, base) < n) {
+ ASSERT(is_hashmap(*ep));
+ if (hashmap_size(*ep) < n) {
FAIL();
}
}
- ep = flatmap_val_rel(*ep, base);
+ ep = flatmap_val(*ep);
break;
case matchPushM:
- if (!is_map_rel(*ep, base)) {
+ if (!is_map(*ep)) {
FAIL();
}
n = *pc++;
- if (is_flatmap_rel(*ep,base)) {
- if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) {
+ if (is_flatmap(*ep)) {
+ if (flatmap_get_size(flatmap_val(*ep)) < n) {
FAIL();
}
} else {
- ASSERT(is_hashmap_rel(*ep,base));
- if (hashmap_size_rel(*ep, base) < n) {
+ ASSERT(is_hashmap(*ep));
+ if (hashmap_size(*ep) < n) {
FAIL();
}
}
- *sp++ = flatmap_val_rel(*ep++, base);
+ *sp++ = flatmap_val(*ep++);
break;
case matchKey:
t = (Eterm) *pc++;
- tp = erts_maps_get_rel(t, make_boxed_rel(ep, base), base);
+ tp = erts_maps_get(t, make_boxed(ep));
if (!tp) {
FAIL();
}
@@ -2061,29 +1977,29 @@ restart:
break;
case matchCmp:
n = *pc++;
- if (!eq_rel(variables[n].term, base, *ep, base))
+ if (!EQ(variables[n].term, *ep))
FAIL();
++ep;
break;
case matchEqBin:
t = (Eterm) *pc++;
- if (!eq_rel(t,NULL,*ep,base))
+ if (!EQ(t,*ep))
FAIL();
++ep;
break;
case matchEqFloat:
- if (!is_float_rel(*ep,base))
+ if (!is_float(*ep))
FAIL();
- if (memcmp(float_val_rel(*ep,base) + 1, pc, sizeof(double)))
+ if (memcmp(float_val(*ep) + 1, pc, sizeof(double)))
FAIL();
pc += TermWords(2);
++ep;
break;
case matchEqRef: {
Eterm* epc = (Eterm*)pc;
- if (!is_ref_rel(*ep,base))
+ if (!is_ref(*ep))
FAIL();
- if (!eq_rel(make_internal_ref_rel(epc, epc), epc, *ep, base)) {
+ if (!EQ(make_internal_ref(epc), *ep)) {
FAIL();
}
i = thing_arityval(*epc);
@@ -2092,9 +2008,9 @@ restart:
break;
}
case matchEqBig:
- if (!is_big_rel(*ep,base))
+ if (!is_big(*ep))
FAIL();
- tp = big_val_rel(*ep,base);
+ tp = big_val(*ep);
{
Eterm *epc = (Eterm *) pc;
if (*tp != *epc)
@@ -2236,62 +2152,36 @@ restart:
esp -= 2;
esp[-1] = t;
break;
-
- #if HALFWORD_HEAP
- case matchPushVGuard:
- if (!base) goto case_matchPushV;
- /* Build NULL-based copy on pseudo heap for easy disposal */
- n = *pc++;
- ASSERT(is_value(variables[n].term));
- ASSERT(!variables[n].proc);
- variables[n].term = copy_object_rel(psp, variables[n].term, base);
- *esp++ = variables[n].term;
- #ifdef DEBUG
- variables[n].proc = psp;
- variables[n].base = NULL;
- #endif
- break;
- #endif
case matchPushVResult:
if (!(in_flags & ERTS_PAM_COPY_RESULT)) goto case_matchPushV;
-
- /* Build (NULL-based) copy on callers heap */
- #if HALFWORD_HEAP
- if (!do_catch && !c_p_checkpoint.p) {
- heap_checkpoint_init(c_p, &c_p_checkpoint);
- }
- #endif
+ /* Build copy on callers heap */
n = *pc++;
ASSERT(is_value(variables[n].term));
ASSERT(!variables[n].proc);
- variables[n].term = copy_object_rel(c_p, variables[n].term, base);
+ variables[n].term = copy_object_x(variables[n].term, c_p, HEAP_XTRA);
*esp++ = variables[n].term;
#ifdef DEBUG
variables[n].proc = c_p;
- variables[n].base = NULL;
#endif
break;
case matchPushV:
case_matchPushV:
n = *pc++;
ASSERT(is_value(variables[n].term));
- ASSERT(!variables[n].base);
*esp++ = variables[n].term;
break;
case matchPushExpr:
if (in_flags & ERTS_PAM_COPY_RESULT) {
Uint sz;
Eterm* top;
- sz = size_object_rel(term, base);
+ sz = size_object(term);
top = HAllocX(build_proc, sz, HEAP_XTRA);
if (in_flags & ERTS_PAM_CONTIGUOUS_TUPLE) {
- ASSERT(is_tuple_rel(term,base));
- *esp++ = copy_shallow_rel(tuple_val_rel(term,base), sz,
- &top, &MSO(build_proc), base);
+ ASSERT(is_tuple(term));
+ *esp++ = copy_shallow(tuple_val(term), sz, &top, &MSO(build_proc));
}
else {
- *esp++ = copy_struct_rel(term, sz, &top, &MSO(build_proc),
- base, NULL);
+ *esp++ = copy_struct(term, sz, &top, &MSO(build_proc));
}
}
else {
@@ -2299,7 +2189,6 @@ restart:
}
break;
case matchPushArrayAsList:
- ASSERT_HALFWORD(base == NULL);
n = arity; /* Only happens when 'term' is an array */
tp = termp;
ehp = HAllocX(build_proc, n*2, HEAP_XTRA);
@@ -2315,7 +2204,6 @@ restart:
break;
case matchPushArrayAsListU:
/* This instruction is NOT efficient. */
- ASSERT_HALFWORD(base == NULL);
*esp++ = dpm_array_to_list(build_proc, termp, arity);
break;
case matchTrue:
@@ -2420,11 +2308,7 @@ restart:
*esp++ = am_true;
break;
case matchIsSeqTrace:
- if (SEQ_TRACE_TOKEN(c_p) != NIL
-#ifdef USE_VM_PROBES
- && SEQ_TRACE_TOKEN(c_p) != am_have_dt_utag
-#endif
- )
+ if (have_seqtrace(SEQ_TRACE_TOKEN(c_p)))
*esp++ = am_true;
else
*esp++ = am_false;
@@ -2448,11 +2332,7 @@ restart:
--esp;
break;
case matchGetSeqToken:
- if (SEQ_TRACE_TOKEN(c_p) == NIL
-#ifdef USE_VM_PROBES
- || SEQ_TRACE_TOKEN(c_p) == am_have_dt_utag
-#endif
- )
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(c_p)))
*esp++ = NIL;
else {
Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p);
@@ -2619,13 +2499,6 @@ restart:
}
}
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
@@ -2788,13 +2661,6 @@ Wterm db_do_read_element(DbUpdateHandle* handle, Sint position)
{
Eterm elem = handle->dbterm->tpl[position];
if (!is_header(elem)) {
-#if HALFWORD_HEAP
- if (!is_immed(elem)
- && !handle->tb->common.compress
- && !(handle->abs_vec && handle->abs_vec[position])) {
- return rterm2wterm(elem, handle->dbterm->tpl);
- }
-#endif
return elem;
}
@@ -2822,9 +2688,6 @@ void db_do_update_element(DbUpdateHandle* handle,
Eterm* oldp;
Uint newval_sz;
Uint oldval_sz;
-#if HALFWORD_HEAP
- Eterm* old_base;
-#endif
if (is_both_immed(newval,oldval)) {
handle->dbterm->tpl[position] = newval;
@@ -2841,15 +2704,8 @@ void db_do_update_element(DbUpdateHandle* handle,
handle->dbterm);
handle->flags |= DB_MUST_RESIZE;
oldval = handle->dbterm->tpl[position];
- #if HALFWORD_HEAP
- old_base = NULL;
- #endif
}
else {
- #if HALFWORD_HEAP
- ASSERT(!handle->abs_vec);
- old_base = handle->dbterm->tpl;
- #endif
if (is_boxed(newval)) {
newp = boxed_val(newval);
switch (*newp & _TAG_HEADER_MASK) {
@@ -2859,7 +2715,7 @@ void db_do_update_element(DbUpdateHandle* handle,
case _TAG_HEADER_HEAP_BIN:
newval_sz = header_arity(*newp) + 1;
if (is_boxed(oldval)) {
- oldp = boxed_val_rel(oldval,old_base);
+ oldp = boxed_val(oldval);
switch (*oldp & _TAG_HEADER_MASK) {
case _TAG_HEADER_POS_BIG:
case _TAG_HEADER_NEG_BIG:
@@ -2879,20 +2735,13 @@ void db_do_update_element(DbUpdateHandle* handle,
}
}
}
-#if HALFWORD_HEAP
- else {
- old_base = (handle->tb->common.compress
- || (handle->abs_vec && handle->abs_vec[position])) ?
- NULL : handle->dbterm->tpl;
- }
-#endif
/* Not possible for simple memcpy or dbterm is already non-contiguous, */
/* need to realloc... */
newval_sz = is_immed(newval) ? 0 : size_object(newval);
new_size_set:
- oldval_sz = is_immed(oldval) ? 0 : size_object_rel(oldval,old_base);
+ oldval_sz = is_immed(oldval) ? 0 : size_object(oldval);
both_size_set:
handle->new_size = handle->new_size - oldval_sz + newval_sz;
@@ -2900,19 +2749,6 @@ both_size_set:
/* write new value in old dbterm, finalize will make a flat copy */
handle->dbterm->tpl[position] = newval;
handle->flags |= DB_MUST_RESIZE;
-
-#if HALFWORD_HEAP
- if (old_base && newval_sz > 0) {
- ASSERT(!handle->tb->common.compress);
- if (!handle->abs_vec) {
- int i = header_arity(handle->dbterm->tpl[0]);
- handle->abs_vec = erts_alloc(ERTS_ALC_T_TMP, (i+1)*sizeof(char));
- sys_memset(handle->abs_vec, 0, i+1);
- /* abs_vec[0] not used */
- }
- handle->abs_vec[position] = 1;
- }
-#endif
}
static ERTS_INLINE byte* db_realloc_term(DbTableCommon* tb, void* old,
@@ -3011,7 +2847,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest,
tpl[arity + 1] = alloc_size;
tmp_offheap.first = NULL;
- tpl[tb->keypos] = copy_struct_rel(key, size_object(key), &top.ep, &tmp_offheap, NULL, tpl);
+ tpl[tb->keypos] = copy_struct(key, size_object(key), &top.ep, &tmp_offheap);
dest->first_oh = tmp_offheap.first;
for (i=1; i<=arity; i++) {
if (i != tb->keypos) {
@@ -3030,7 +2866,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest,
Eterm* dbg_top = erts_alloc(ERTS_ALC_T_DB_TERM, dest->size * sizeof(Eterm));
dest->debug_clone = dbg_top;
tmp_offheap.first = dest->first_oh;
- copy_struct_rel(obj, dest->size, &dbg_top, &tmp_offheap, NULL, dbg_top);
+ copy_struct(obj, dest->size, &dbg_top, &tmp_offheap);
dest->first_oh = tmp_offheap.first;
ASSERT(dbg_top == dest->debug_clone + dest->size);
}
@@ -3077,7 +2913,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj)
newp->size = size;
top = newp->tpl;
tmp_offheap.first = NULL;
- copy_struct_rel(obj, size, &top, &tmp_offheap, NULL, top);
+ copy_struct(obj, size, &top, &tmp_offheap);
newp->first_oh = tmp_offheap.first;
#ifdef DEBUG_CLONE
newp->debug_clone = NULL;
@@ -3160,29 +2996,8 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset)
tmp_offheap.first = NULL;
- #if HALFWORD_HEAP
- if (handle->abs_vec) {
- int i, arity = header_arity(handle->dbterm->tpl[0]);
-
- top[0] = tpl[0];
- top += arity + 1;
- for (i=1; i<=arity; i++) {
- Eterm* src_base = handle->abs_vec[i] ? NULL : tpl;
-
- newDbTerm->tpl[i] = copy_struct_rel(tpl[i],
- size_object_rel(tpl[i],src_base),
- &top, &tmp_offheap, src_base,
- newDbTerm->tpl);
- }
- newDbTerm->first_oh = tmp_offheap.first;
- ASSERT((byte*)top <= (newp + alloc_sz));
- erts_free(ERTS_ALC_T_TMP, handle->abs_vec);
- }
- else
- #endif /* HALFWORD_HEAP */
{
- copy_struct_rel(make_tuple_rel(tpl,tpl), handle->new_size, &top,
- &tmp_offheap, tpl, top);
+ copy_struct(make_tuple(tpl), handle->new_size, &top, &tmp_offheap);
newDbTerm->first_oh = tmp_offheap.first;
ASSERT((byte*)top == (newp + alloc_sz));
}
@@ -3199,9 +3014,9 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp,
hp[0] = bp->tpl[0];
*hpp += arity + 1;
- hp[tb->keypos] = copy_struct_rel(bp->tpl[tb->keypos],
- size_object_rel(bp->tpl[tb->keypos], bp->tpl),
- hpp, off_heap, bp->tpl, NULL);
+ hp[tb->keypos] = copy_struct(bp->tpl[tb->keypos],
+ size_object(bp->tpl[tb->keypos]),
+ hpp, off_heap);
erts_factory_static_init(&factory, *hpp, bp->size - (arity+1), off_heap);
@@ -3221,7 +3036,7 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp,
ASSERT((*hpp - hp) <= bp->size);
#ifdef DEBUG_CLONE
- ASSERT(eq_rel(make_tuple(hp),NULL,make_tuple(bp->debug_clone),bp->debug_clone));
+ ASSERT(EQ(make_tuple(hp),make_tuple(bp->debug_clone)));
#endif
return make_tuple(hp);
}
@@ -3245,14 +3060,14 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p,
*hpp = erts_produce_heap(&factory, extra, 0);
erts_factory_close(&factory);
#ifdef DEBUG_CLONE
- ASSERT(eq_rel(copy, NULL, obj->debug_clone[pos], obj->debug_clone));
+ ASSERT(EQ(copy, obj->debug_clone[pos]));
#endif
return copy;
}
else {
- Uint sz = size_object_rel(obj->tpl[pos], obj->tpl);
+ Uint sz = size_object(obj->tpl[pos]);
*hpp = HAlloc(p, sz + extra);
- return copy_struct_rel(obj->tpl[pos], sz, hpp, &MSO(p), obj->tpl, NULL);
+ return copy_struct(obj->tpl[pos], sz, hpp, &MSO(p));
}
}
@@ -3599,26 +3414,10 @@ static DMCRet dmc_one_term(DMCContext *context,
{
Eterm* ref_val = internal_ref_val(c);
DMC_PUSH(*text, matchEqRef);
-#if HALFWORD_HEAP
- {
- union {
- UWord u;
- Uint t[2];
- } fiddle;
- ASSERT(thing_arityval(ref_val[0]) == 3);
- fiddle.t[0] = ref_val[0];
- fiddle.t[1] = ref_val[1];
- DMC_PUSH(*text, fiddle.u);
- fiddle.t[0] = ref_val[2];
- fiddle.t[1] = ref_val[3];
- DMC_PUSH(*text, fiddle.u);
- }
-#else
n = thing_arityval(ref_val[0]);
for (i = 0; i <= n; ++i) {
DMC_PUSH(*text, ref_val[i]);
}
-#endif
break;
}
case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
@@ -3627,53 +3426,19 @@ static DMCRet dmc_one_term(DMCContext *context,
Eterm* bval = big_val(c);
n = thing_arityval(bval[0]);
DMC_PUSH(*text, matchEqBig);
-#if HALFWORD_HEAP
- {
- union {
- UWord u;
- Uint t[2];
- } fiddle;
- ASSERT(n >= 1);
- fiddle.t[0] = bval[0];
- fiddle.t[1] = bval[1];
- DMC_PUSH(*text, fiddle.u);
- for (i = 2; i <= n; ++i) {
- fiddle.t[0] = bval[i];
- if (++i <= n) {
- fiddle.t[1] = bval[i];
- } else {
- fiddle.t[1] = (Uint) 0;
- }
- DMC_PUSH(*text, fiddle.u);
- }
- }
-#else
for (i = 0; i <= n; ++i) {
DMC_PUSH(*text, (Uint) bval[i]);
}
-#endif
break;
}
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
DMC_PUSH(*text,matchEqFloat);
-#if HALFWORD_HEAP
- {
- union {
- UWord u;
- Uint t[2];
- } fiddle;
- fiddle.t[0] = float_val(c)[1];
- fiddle.t[1] = float_val(c)[2];
- DMC_PUSH(*text, fiddle.u);
- }
-#else
DMC_PUSH(*text, (Uint) float_val(c)[1]);
#ifdef ARCH_64
DMC_PUSH(*text, (Uint) 0);
#else
DMC_PUSH(*text, (Uint) float_val(c)[2]);
#endif
-#endif
break;
default: /* BINARY, FUN, VECTOR, or EXTERNAL */
DMC_PUSH(*text, matchEqBin);
@@ -3997,24 +3762,8 @@ static void dmc_add_pushv_variant(DMCContext *context, DMCHeap *heap,
MatchOps instr = matchPushV;
ASSERT(n < heap->vars_used && v->is_bound);
- if (context->is_guard) {
- #if HALFWORD_HEAP
- if (!v->first_guard_label) {
- v->first_guard_label = DMC_STACK_NUM(*text);
- ASSERT(v->first_guard_label);
- instr = matchPushVGuard; /* may be changed to PushVResult below */
- }
- #endif
- }
- else { /* body */
- #if HALFWORD_HEAP
- if (v->first_guard_label) {
- /* Avoid double-copy, copy to result heap at first encounter in guard */
- DMC_POKE(*text, v->first_guard_label, matchPushVResult);
- v->is_in_body = 1;
- }
- #endif
- if (!v->is_in_body) {
+ if (!context->is_guard) {
+ if(!v->is_in_body) {
instr = matchPushVResult;
v->is_in_body = 1;
}
@@ -5443,16 +5192,13 @@ Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog,
int all, DbTerm* obj, Eterm** hpp, Uint extra)
{
Uint32 dummy;
- Eterm* base;
Eterm res;
if (tb->compress) {
obj = db_alloc_tmp_uncompressed(tb, obj);
- base = NULL;
}
- else base = HALFWORD_HEAP ? obj->tpl : NULL;
- res = db_prog_match(c_p, bprog, make_tuple_rel(obj->tpl,base), base, NULL, 0,
+ res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), NULL, 0,
ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy);
if (is_value(res) && hpp!=NULL) {
@@ -5573,7 +5319,7 @@ void db_match_dis(Binary *bp)
first = 0;
else
erts_printf(", ");
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
erts_printf("0x%016bex", rt->data.ui[ri]);
#else
erts_printf("0x%08bex", rt->data.ui[ri]);
@@ -5597,7 +5343,7 @@ void db_match_dis(Binary *bp)
first = 0;
else
erts_printf(", ");
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
erts_printf("0x%016bex", *et);
#else
erts_printf("0x%08bex", *et);
@@ -5720,13 +5466,6 @@ void db_match_dis(Binary *bp)
++t;
erts_printf("PushV\t%beu\n", n);
break;
- #if HALFWORD_HEAP
- case matchPushVGuard:
- n = (Uint) *++t;
- ++t;
- erts_printf("PushVGuard\t%beu\n", n);
- break;
- #endif
case matchPushVResult:
n = (Uint) *++t;
++t;
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index 0903a40460..911ed37aef 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -90,9 +90,6 @@ typedef struct {
Uint new_size;
int flags;
void* lck;
-#if HALFWORD_HEAP
- unsigned char* abs_vec; /* [i] true if dbterm->tpl[i] is absolute Eterm */
-#endif
} DbUpdateHandle;
@@ -290,10 +287,10 @@ ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj)
Eterm key = GETKEY(tb, obj->tpl);
if IS_CONST(key) return key;
else {
- Uint size = size_object_rel(key, obj->tpl);
+ Uint size = size_object(key);
Eterm* hp = HAlloc(p, size);
- Eterm res = copy_struct_rel(key, size, &hp, &MSO(p), obj->tpl, NULL);
- ASSERT(eq_rel(res,NULL,key,obj->tpl));
+ Eterm res = copy_struct(key, size, &hp, &MSO(p));
+ ASSERT(EQ(res,key));
return res;
}
}
@@ -305,14 +302,14 @@ ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp,
return db_copy_from_comp(tb, bp, hpp, off_heap);
}
else {
- return copy_shallow_rel(bp->tpl, bp->size, hpp, off_heap, bp->tpl);
+ return copy_shallow(bp->tpl, bp->size, hpp, off_heap);
}
}
ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b)
{
if (!tb->compress) {
- return eq_rel(a, NULL, make_tuple_rel(b->tpl,b->tpl), b->tpl);
+ return EQ(a, make_tuple(b->tpl));
}
else {
return db_eq_comp(tb, a, b);
@@ -438,7 +435,7 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards,
Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog,
int all, DbTerm* obj, Eterm** hpp, Uint extra);
-Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm* base,
+Eterm db_prog_match(Process *p, Binary *prog, Eterm term,
Eterm *termp, int arity,
enum erts_pam_run_flags in_flags,
Uint32 *return_flags /* Zeroed on enter */);
diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c
index 2dcfb79f00..7b13cf2c83 100644
--- a/erts/emulator/beam/erl_debug.c
+++ b/erts/emulator/beam/erl_debug.c
@@ -312,6 +312,8 @@ void erts_check_for_holes(Process* p)
p->last_htop = HEAP_TOP(p);
for (hf = MBUF(p); hf != 0; hf = hf->next) {
+ if (hf == p->heap_hfrag)
+ continue;
if (hf == p->last_mbuf) {
break;
}
@@ -402,7 +404,7 @@ void verify_process(Process *p)
erl_exit(1,"Wild pointer found in " name " of %T!\n",p->common.id); }
- ErlMessage* mp = p->msg.first;
+ ErtsMessage* mp = p->msg.first;
VERBOSE(DEBUG_MEMORY,("Verify process: %T...\n",p->common.id));
@@ -416,7 +418,7 @@ void verify_process(Process *p)
erts_check_heap(p);
if (p->dictionary)
- VERIFY_AREA("dictionary",p->dictionary->data, p->dictionary->used);
+ VERIFY_AREA("dictionary", ERTS_PD_START(p->dictionary), ERTS_PD_SIZE(p->dictionary));
VERIFY_ETERM("seq trace token",p->seq_trace_token);
VERIFY_ETERM("group leader",p->group_leader);
VERIFY_ETERM("fvalue",p->fvalue);
@@ -531,7 +533,7 @@ static void print_process_memory(Process *p)
PTR_SIZE, "PCB", dashes, dashes, dashes, dashes);
if (p->msg.first != NULL) {
- ErlMessage* mp;
+ ErtsMessage* mp;
erts_printf(" Message Queue:\n");
mp = p->msg.first;
while (mp != NULL) {
@@ -542,8 +544,8 @@ static void print_process_memory(Process *p)
}
if (p->dictionary != NULL) {
- int n = p->dictionary->used;
- Eterm *ptr = p->dictionary->data;
+ int n = ERTS_PD_SIZE(p->dictionary);
+ Eterm *ptr = ERTS_PD_START(p->dictionary);
erts_printf(" Dictionary: ");
while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)ptr++);
erts_printf("\n");
@@ -631,29 +633,4 @@ void print_memory_info(Process *p)
}
erts_printf("+-----------------%s-%s-%s-%s-+\n",dashes,dashes,dashes,dashes);
}
-#if !HEAP_ON_C_STACK && defined(DEBUG)
-Eterm *erts_debug_allocate_tmp_heap(int size, Process *p)
-{
- ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p));
- int offset = sd->num_tmp_heap_used;
-
- ASSERT(offset+size <= TMP_HEAP_SIZE);
- return (sd->tmp_heap)+offset;
-}
-void erts_debug_use_tmp_heap(int size, Process *p)
-{
- ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p));
-
- sd->num_tmp_heap_used += size;
- ASSERT(sd->num_tmp_heap_used <= TMP_HEAP_SIZE);
-}
-void erts_debug_unuse_tmp_heap(int size, Process *p)
-{
- ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p));
-
- sd->num_tmp_heap_used -= size;
- ASSERT(sd->num_tmp_heap_used >= 0);
-}
-#endif
#endif
-
diff --git a/erts/emulator/beam/erl_debug.h b/erts/emulator/beam/erl_debug.h
index 4905e64f07..029320691d 100644
--- a/erts/emulator/beam/erl_debug.h
+++ b/erts/emulator/beam/erl_debug.h
@@ -48,6 +48,7 @@
#define DEBUG_THREADS 0x0010 /* Thread-related stuff */
#define DEBUG_PROCESSES 0x0020 /* Process creation and removal */
#define DEBUG_MEMORY 0x0040 /* Display results of memory checks */
+#define DEBUG_SHCOPY 0x0080 /* Sharing-preserving copying of terms */
extern Uint32 verbose;
@@ -92,10 +93,4 @@ extern void print_tagged_memory(Eterm *start, Eterm *end);
extern void print_untagged_memory(Eterm *start, Eterm *end);
extern void print_memory(Process *p);
extern void print_memory_info(Process *p);
-#if defined(DEBUG) && !HEAP_ON_C_STACK
-extern Eterm *erts_debug_allocate_tmp_heap(int, Process *);
-extern void erts_debug_use_tmp_heap(int, Process *);
-extern void erts_debug_unuse_tmp_heap(int, Process *);
-#endif
-
#endif /* _ERL_DEBUG_H_ */
diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h
index 7ab58e336b..0234b9b0e4 100644
--- a/erts/emulator/beam/erl_driver.h
+++ b/erts/emulator/beam/erl_driver.h
@@ -37,11 +37,6 @@
# endif
#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>
@@ -131,6 +126,7 @@ 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
@@ -340,22 +336,23 @@ typedef struct erl_drv_entry {
#ifdef STATIC_ERLANG_DRIVER
# define ERLANG_DRIVER_NAME(NAME) NAME ## _driver_init
+# define ERL_DRIVER_EXPORT
#else
# define ERLANG_DRIVER_NAME(NAME) driver_init
+# if defined(__GNUC__) && __GNUC__ >= 4
+# define ERL_DRIVER_EXPORT __attribute__ ((visibility("default")))
+# elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550)
+# define ERL_DRIVER_EXPORT __global
+# else
+# define ERL_DRIVER_EXPORT
+# endif
#endif
-/* For windows dynamic drivers */
#ifndef ERL_DRIVER_TYPES_ONLY
-#if defined(__WIN32__)
-# define DRIVER_INIT(DRIVER_NAME) \
- __declspec(dllexport) ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \
- __declspec(dllexport) ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void)
-#else
-# define DRIVER_INIT(DRIVER_NAME) \
- ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \
- ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void)
-#endif
+#define DRIVER_INIT(DRIVER_NAME) \
+ ERL_DRIVER_EXPORT ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \
+ ERL_DRIVER_EXPORT ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void)
#define ERL_DRV_BUSY_MSGQ_DISABLED (~((ErlDrvSizeT) 0))
#define ERL_DRV_BUSY_MSGQ_READ_ONLY ((ErlDrvSizeT) 0)
@@ -661,15 +658,11 @@ EXTERN char *driver_dl_error(void);
EXTERN int erl_drv_putenv(const char *key, char *value);
EXTERN int erl_drv_getenv(const 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
+/* 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_fun.c b/erts/emulator/beam/erl_fun.c
index 4268e2d40a..cff476694c 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -66,6 +66,9 @@ erts_init_fun_table(void)
f.cmp = (HCMP_FUN) fun_cmp;
f.alloc = (HALLOC_FUN) fun_alloc;
f.free = (HFREE_FUN) fun_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_FUN_TABLE, &erts_fun_table, "fun_table", 16, f);
}
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 2f21111a2e..21b03ae8bd 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -47,6 +47,17 @@
#define ERTS_INACT_WR_PB_LEAVE_LIMIT 10
#define ERTS_INACT_WR_PB_LEAVE_PERCENTAGE 10
+#if defined(DEBUG) || 0
+#define ERTS_GC_DEBUG
+#else
+#undef ERTS_GC_DEBUG
+#endif
+#ifdef ERTS_GC_DEBUG
+# define ERTS_GC_ASSERT ASSERT
+#else
+# define ERTS_GC_ASSERT(B) ((void) 1)
+#endif
+
/*
* Returns number of elements in an array.
*/
@@ -67,10 +78,10 @@
#define ErtsGcQuickSanityCheck(P) \
do { \
ASSERT((P)->heap < (P)->hend); \
- ASSERT((P)->heap_sz == (P)->hend - (P)->heap); \
+ ASSERT((p)->abandoned_heap || (P)->heap_sz == (P)->hend - (P)->heap); \
ASSERT((P)->heap <= (P)->htop && (P)->htop <= (P)->hend); \
ASSERT((P)->heap <= (P)->stop && (P)->stop <= (P)->hend); \
- ASSERT((P)->heap <= (P)->high_water && (P)->high_water <= (P)->hend);\
+ ASSERT((p)->abandoned_heap || ((P)->heap <= (P)->high_water && (P)->high_water <= (P)->hend)); \
OverRunCheck((P)); \
} while (0)
#else
@@ -98,18 +109,33 @@ typedef struct {
static Uint setup_rootset(Process*, Eterm*, int, Rootset*);
static void cleanup_rootset(Rootset *rootset);
-static Uint combined_message_size(Process* p);
static void remove_message_buffers(Process* p);
-static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl);
-static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl);
-static void do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj);
-static Eterm* sweep_rootset(Rootset *rootset, Eterm* htop, char* src, Uint src_size);
-static Eterm* sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size);
-static Eterm* sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
- char* src, Uint src_size);
-static Eterm* collect_heap_frags(Process* p, Eterm* heap,
- Eterm* htop, Eterm* objv, int nobj);
-static void adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj);
+static Eterm *full_sweep_heaps(Process *p,
+ int hibernate,
+ Eterm *n_heap, Eterm* n_htop,
+ char *oh, Uint oh_size,
+ Eterm *objv, int nobj);
+static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj);
+static int major_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj, Uint *recl);
+static int minor_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj, Uint *recl);
+static void do_minor(Process *p, ErlHeapFragment *live_hf_end,
+ char *mature, Uint mature_size,
+ Uint new_sz, Eterm* objv, int nobj);
+static Eterm *sweep_new_heap(Eterm *n_hp, Eterm *n_htop,
+ char* old_heap, Uint old_heap_size);
+static Eterm *sweep_heaps(Eterm *n_hp, Eterm *n_htop,
+ char* old_heap, Uint old_heap_size);
+static Eterm* sweep_literal_area(Eterm* n_hp, Eterm* n_htop,
+ char* old_heap, Uint old_heap_size,
+ char* src, Uint src_size);
+static Eterm* sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
+ char* src, Uint src_size);
+static Eterm* collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end,
+ Eterm* heap, Eterm* htop, Eterm* objv, int nobj);
+static int adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj);
static void shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj);
static void grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj);
static void sweep_off_heap(Process *p, int fullsweep);
@@ -119,16 +145,16 @@ static void offset_rootset(Process *p, Sint offs, char* area, Uint area_size,
Eterm* objv, int nobj);
static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size);
static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size);
+static void move_msgq_to_heap(Process *p);
static void init_gc_info(ErtsGCInfo *gcip);
#ifdef HARDDEBUG
static void disallow_heap_frag_ref_in_heap(Process* p);
static void disallow_heap_frag_ref_in_old_heap(Process* p);
-static void disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj);
#endif
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
# define MAX_HEAP_SIZES 154
#else
# define MAX_HEAP_SIZES 59
@@ -147,26 +173,24 @@ typedef struct {
erts_smp_atomic32_t refc;
} ErtsGCInfoReq;
-#if !HALFWORD_HEAP
-ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq,
- ErtsGCInfoReq,
- 5,
- ERTS_ALC_T_GC_INFO_REQ)
-#else
-static ERTS_INLINE ErtsGCInfoReq *
-gcireq_alloc(void)
+static ERTS_INLINE int
+gc_cost(Uint gc_moved_live_words, Uint resize_moved_words)
{
- return erts_alloc(ERTS_ALC_T_GC_INFO_REQ,
- sizeof(ErtsGCInfoReq));
-}
+ Sint reds;
-static ERTS_INLINE void
-gcireq_free(ErtsGCInfoReq *ptr)
-{
- erts_free(ERTS_ALC_T_GC_INFO_REQ, ptr);
+ reds = gc_moved_live_words/10;
+ reds += resize_moved_words/100;
+ if (reds < 1)
+ return 1;
+ if (reds > INT_MAX)
+ return INT_MAX;
+ return (int) reds;
}
-#endif
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq,
+ ErtsGCInfoReq,
+ 5,
+ ERTS_ALC_T_GC_INFO_REQ)
/*
* Initialize GC global data.
*/
@@ -208,7 +232,7 @@ erts_init_gc(void)
}
- /* for 32 bit we want max_heap_size to be MAX(32bit) / 4 [words] (and halfword)
+ /* for 32 bit we want max_heap_size to be MAX(32bit) / 4 [words]
* for 64 bit we want max_heap_size to be MAX(52bit) / 8 [words]
*/
@@ -232,10 +256,7 @@ erts_init_gc(void)
init_gc_info(&esdp->gc_info);
}
-#if !HALFWORD_HEAP
init_gcireq_alloc();
-#endif
-
}
/*
@@ -351,10 +372,19 @@ erts_offset_off_heap(ErlOffHeap *ohp, Sint offs, Eterm* low, Eterm* high)
#undef ptr_within
Eterm
-erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity)
+erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end,
+ Eterm result, Eterm* regs, Uint arity)
{
int cost;
+ if (p->flags & F_HIBERNATE_SCHED) {
+ /*
+ * We just hibernated. We do *not* want to mess
+ * up the hibernation by an ordinary GC...
+ */
+ return result;
+ }
+
if (is_non_value(result)) {
if (p->freason == TRAP) {
#if HIPE
@@ -362,21 +392,28 @@ erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity)
regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array;
}
#endif
- cost = erts_garbage_collect(p, 0, regs, p->arity);
+ cost = garbage_collect(p, live_hf_end, 0, regs, p->arity);
} else {
- cost = erts_garbage_collect(p, 0, regs, arity);
+ cost = garbage_collect(p, live_hf_end, 0, regs, arity);
}
} else {
Eterm val[1];
val[0] = result;
- cost = erts_garbage_collect(p, 0, val, 1);
+ cost = garbage_collect(p, live_hf_end, 0, val, 1);
result = val[0];
}
BUMP_REDS(p, cost);
return result;
}
+Eterm
+erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity)
+{
+ return erts_gc_after_bif_call_lhf(p, ERTS_INVALID_HFRAG_PTR,
+ result, regs, arity);
+}
+
static ERTS_INLINE void reset_active_writer(Process *p)
{
struct erl_off_heap_header* ptr;
@@ -390,6 +427,139 @@ static ERTS_INLINE void reset_active_writer(Process *p)
}
}
+#define ERTS_DELAY_GC_EXTRA_FREE 40
+#define ERTS_ABANDON_HEAP_COST 10
+
+static int
+delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need)
+{
+ ErlHeapFragment *hfrag;
+ Eterm *orig_heap, *orig_hend, *orig_htop, *orig_stop;
+ Eterm *stop, *hend;
+ Uint hsz, ssz;
+ int reds_left;
+
+ ERTS_HOLE_CHECK(p);
+
+ if ((p->flags & F_DISABLE_GC)
+ && p->live_hf_end == ERTS_INVALID_HFRAG_PTR) {
+ /*
+ * A BIF yielded with disabled GC. Remember
+ * heap fragments created by the BIF until we
+ * do next GC.
+ */
+ p->live_hf_end = live_hf_end;
+ }
+
+ if (need == 0)
+ return 1;
+
+ /*
+ * Satisfy need in a heap fragment...
+ */
+ ASSERT(need > 0);
+
+ orig_heap = p->heap;
+ orig_hend = p->hend;
+ orig_htop = p->htop;
+ orig_stop = p->stop;
+
+ ssz = orig_hend - orig_stop;
+ hsz = ssz + need + ERTS_DELAY_GC_EXTRA_FREE;
+
+ hfrag = new_message_buffer(hsz);
+ hfrag->next = p->mbuf;
+ p->mbuf = hfrag;
+ p->mbuf_sz += hsz;
+ p->heap = p->htop = &hfrag->mem[0];
+ p->hend = hend = &hfrag->mem[hsz];
+ p->stop = stop = hend - ssz;
+ sys_memcpy((void *) stop, (void *) orig_stop, ssz * sizeof(Eterm));
+
+ if (p->abandoned_heap) {
+ /* Active heap already in a fragment; adjust it... */
+ ErlHeapFragment *hfrag = ((ErlHeapFragment *)
+ (((char *) orig_heap)
+ - offsetof(ErlHeapFragment, mem)));
+ Uint unused = orig_hend - orig_htop;
+ ASSERT(hfrag->used_size == hfrag->alloc_size);
+ ASSERT(hfrag->used_size >= unused);
+ hfrag->used_size -= unused;
+ p->mbuf_sz -= unused;
+ }
+ else {
+ /* Do not leave a hole in the abandoned heap... */
+ if (orig_htop < orig_hend) {
+ *orig_htop = make_pos_bignum_header(orig_hend-orig_htop-1);
+ if (orig_htop + 1 < orig_hend) {
+ orig_hend[-1] = (Uint) (orig_htop - orig_heap);
+ p->flags |= F_ABANDONED_HEAP_USE;
+ }
+ }
+ p->abandoned_heap = orig_heap;
+ }
+
+#ifdef CHECK_FOR_HOLES
+ p->last_htop = p->htop;
+ p->heap_hfrag = hfrag;
+#endif
+
+ /* Make sure that we do a proper GC as soon as possible... */
+ p->flags |= F_FORCE_GC;
+ reds_left = ERTS_BIF_REDS_LEFT(p);
+ if (reds_left > ERTS_ABANDON_HEAP_COST) {
+ int vreds = reds_left - ERTS_ABANDON_HEAP_COST;
+ ERTS_VBUMP_REDS(p, vreds);
+ }
+ return ERTS_ABANDON_HEAP_COST;
+}
+
+static ERTS_FORCE_INLINE Uint
+young_gen_usage(Process *p)
+{
+ Uint hsz;
+ Eterm *aheap;
+
+ hsz = p->mbuf_sz;
+
+ if (p->flags & F_ON_HEAP_MSGQ) {
+ ErtsMessage *mp;
+ for (mp = p->msg.first; mp; mp = mp->next)
+ if (mp->data.attached)
+ hsz += erts_msg_attached_data_size(mp);
+ }
+
+ aheap = p->abandoned_heap;
+ if (!aheap)
+ hsz += p->htop - p->heap;
+ else {
+ /* used in orig heap */
+ if (p->flags & F_ABANDONED_HEAP_USE)
+ hsz += aheap[p->heap_sz-1];
+ else
+ hsz += p->heap_sz;
+ /* Remove unused part in latest fragment */
+ hsz -= p->hend - p->htop;
+ }
+ return hsz;
+}
+
+#define ERTS_GET_ORIG_HEAP(Proc, Heap, HTop) \
+ do { \
+ Eterm *aheap__ = (Proc)->abandoned_heap; \
+ if (!aheap__) { \
+ (Heap) = (Proc)->heap; \
+ (HTop) = (Proc)->htop; \
+ } \
+ else { \
+ (Heap) = aheap__; \
+ if ((Proc)->flags & F_ABANDONED_HEAP_USE) \
+ (HTop) = aheap__ + aheap__[(Proc)->heap_sz-1]; \
+ else \
+ (HTop) = aheap__ + (Proc)->heap_sz; \
+ } \
+ } while (0)
+
/*
* Garbage collect a process.
*
@@ -398,21 +568,28 @@ static ERTS_INLINE void reset_active_writer(Process *p)
* objv: Array of terms to add to rootset; that is to preserve.
* nobj: Number of objects in objv.
*/
-int
-erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
+static int
+garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj)
{
Uint reclaimed_now = 0;
- int done = 0;
+ int reds;
ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */
ErtsSchedulerData *esdp;
+ ERTS_MSACC_PUSH_STATE_M();
#ifdef USE_VM_PROBES
DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
#endif
- if (p->flags & F_DISABLE_GC) {
- ASSERT(need == 0);
- return 1;
- }
+ if (p->flags & (F_DISABLE_GC|F_DELAY_GC))
+ return delay_garbage_collection(p, live_hf_end, need);
+
+ if (p->abandoned_heap)
+ live_hf_end = ERTS_INVALID_HFRAG_PTR;
+ else if (p->live_hf_end != ERTS_INVALID_HFRAG_PTR)
+ live_hf_end = p->live_hf_end;
+
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_GC);
esdp = erts_get_scheduler_data();
@@ -420,16 +597,14 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
trace_gc(p, am_gc_start);
}
- (void) erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
+ erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
if (erts_system_monitor_long_gc != 0)
start_time = erts_get_monotonic_time(esdp);
ERTS_CHK_OFFHEAP(p);
ErtsGcQuickSanityCheck(p);
- if (GEN_GCS(p) >= MAX_GEN_GCS(p)) {
- FLAGS(p) |= F_NEED_FULLSWEEP;
- }
+
#ifdef USE_VM_PROBES
*pidbuf = '\0';
if (DTRACE_ENABLED(gc_major_start)
@@ -442,17 +617,23 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
/*
* Test which type of GC to do.
*/
- while (!done) {
- if ((FLAGS(p) & F_NEED_FULLSWEEP) != 0) {
- DTRACE2(gc_major_start, pidbuf, need);
- done = major_collection(p, need, objv, nobj, &reclaimed_now);
- DTRACE2(gc_major_end, pidbuf, reclaimed_now);
- } else {
- DTRACE2(gc_minor_start, pidbuf, need);
- done = minor_collection(p, need, objv, nobj, &reclaimed_now);
- DTRACE2(gc_minor_end, pidbuf, reclaimed_now);
- }
+
+ if (GEN_GCS(p) < MAX_GEN_GCS(p) && !(FLAGS(p) & F_NEED_FULLSWEEP)) {
+ DTRACE2(gc_minor_start, pidbuf, need);
+ reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now);
+ DTRACE2(gc_minor_end, pidbuf, reclaimed_now);
+ if (reds < 0)
+ goto do_major_collection;
+ }
+ else {
+ do_major_collection:
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC_FULL);
+ DTRACE2(gc_major_start, pidbuf, need);
+ reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now);
+ DTRACE2(gc_major_end, pidbuf, reclaimed_now);
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC);
}
+
reset_active_writer(p);
/*
@@ -491,6 +672,9 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
esdp->gc_info.reclaimed += reclaimed_now;
FLAGS(p) &= ~F_FORCE_GC;
+ p->live_hf_end = ERTS_INVALID_HFRAG_PTR;
+
+ ERTS_MSACC_POP_STATE_M();
#ifdef CHECK_FOR_HOLES
/*
@@ -512,15 +696,20 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
p->last_old_htop = p->old_htop;
#endif
- /* FIXME: This function should really return an Sint, i.e., a possibly
- 64 bit wide signed integer, but that requires updating all the code
- that calls it. For now, we just return INT_MAX if the result is too
- large for an int. */
- {
- Sint result = (HEAP_TOP(p) - HEAP_START(p)) / 10;
- if (result >= INT_MAX) return INT_MAX;
- else return (int) result;
- }
+ return reds;
+}
+
+int
+erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj)
+{
+ return garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj);
+}
+
+void
+erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
+{
+ int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj);
+ BUMP_REDS(p, reds);
}
/*
@@ -533,13 +722,11 @@ erts_garbage_collect_hibernate(Process* p)
Uint heap_size;
Eterm* heap;
Eterm* htop;
- Rootset rootset;
- char* src;
- Uint src_size;
Uint actual_size;
char* area;
Uint area_size;
Sint offs;
+ int reds;
if (p->flags & F_DISABLE_GC)
ERTS_INTERNAL_ERROR("GC disabled");
@@ -549,8 +736,6 @@ erts_garbage_collect_hibernate(Process* p)
*/
erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
ErtsGcQuickSanityCheck(p);
- ASSERT(p->mbuf_sz == 0);
- ASSERT(p->mbuf == 0);
ASSERT(p->stop == p->hend); /* Stack must be empty. */
/*
@@ -558,46 +743,25 @@ erts_garbage_collect_hibernate(Process* p)
*/
- heap_size = p->heap_sz + (p->old_htop - p->old_heap);
+ heap_size = p->heap_sz + (p->old_htop - p->old_heap) + p->mbuf_sz;
heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP,
sizeof(Eterm)*heap_size);
htop = heap;
- (void) setup_rootset(p, p->arg_reg, p->arity, &rootset);
-#if HIPE
- hipe_empty_nstack(p);
-#endif
-
- src = (char *) p->heap;
- src_size = (char *) p->htop - src;
- htop = sweep_rootset(&rootset, htop, src, src_size);
- htop = sweep_one_area(heap, htop, src, src_size);
+ htop = full_sweep_heaps(p,
+ 1,
+ heap,
+ htop,
+ (char *) p->old_heap,
+ (char *) p->old_htop - (char *) p->old_heap,
+ p->arg_reg,
+ p->arity);
- if (p->old_heap) {
- src = (char *) p->old_heap;
- src_size = (char *) p->old_htop - src;
- htop = sweep_rootset(&rootset, htop, src, src_size);
- htop = sweep_one_area(heap, htop, src, src_size);
- }
-
- cleanup_rootset(&rootset);
-
- if (MSO(p).first) {
- sweep_off_heap(p, 1);
- }
-
- /*
- * Update all pointers.
- */
ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (void*)HEAP_START(p),
- HEAP_SIZE(p) * sizeof(Eterm));
- if (p->old_heap) {
- ERTS_HEAP_FREE(ERTS_ALC_T_OLD_HEAP,
- (void*)p->old_heap,
- (p->old_hend - p->old_heap) * sizeof(Eterm));
- p->old_heap = p->old_htop = p->old_hend = 0;
- }
+ (p->abandoned_heap
+ ? p->abandoned_heap
+ : p->heap),
+ p->heap_sz * sizeof(Eterm));
p->heap = heap;
p->high_water = htop;
@@ -612,6 +776,7 @@ erts_garbage_collect_hibernate(Process* p)
}
FLAGS(p) &= ~F_FORCE_GC;
+ p->live_hf_end = ERTS_INVALID_HFRAG_PTR;
/*
* Move the heap to its final destination.
@@ -631,6 +796,8 @@ erts_garbage_collect_hibernate(Process* p)
sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm));
ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm));
+ remove_message_buffers(p);
+
p->stop = p->hend = heap + heap_size;
offs = heap - p->heap;
@@ -659,15 +826,18 @@ erts_garbage_collect_hibernate(Process* p)
ErtsGcQuickSanityCheck(p);
erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
+
+ reds = gc_cost(actual_size, actual_size);
+ BUMP_REDS(p, reds);
}
void
erts_garbage_collect_literals(Process* p, Eterm* literals,
- Uint lit_size,
+ Uint byte_lit_size,
struct erl_off_heap_header* oh)
{
- Uint byte_lit_size = sizeof(Eterm)*lit_size;
+ Uint lit_size = byte_lit_size / sizeof(Eterm);
Uint old_heap_size;
Eterm* temp_lit;
Sint offs;
@@ -743,7 +913,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
- } else if (in_area(ptr, area, area_size)) {
+ } else if (ErtsInArea(ptr, area, area_size)) {
MOVE_BOXED(ptr,val,old_htop,g_ptr++);
} else {
g_ptr++;
@@ -754,7 +924,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
val = *ptr;
if (IS_MOVED_CONS(val)) { /* Moved */
*g_ptr++ = ptr[1];
- } else if (in_area(ptr, area, area_size)) {
+ } else if (ErtsInArea(ptr, area, area_size)) {
MOVE_CONS(ptr,val,old_htop,g_ptr++);
} else {
g_ptr++;
@@ -774,8 +944,10 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
* Now we'll have to go through all heaps updating all other references.
*/
- old_htop = sweep_one_heap(p->heap, p->htop, old_htop, area, area_size);
- old_htop = sweep_one_area(p->old_heap, old_htop, area, area_size);
+ old_htop = sweep_literals_to_old_heap(p->heap, p->htop, old_htop, area, area_size);
+ old_htop = sweep_literal_area(p->old_heap, old_htop,
+ (char *) p->old_heap, sizeof(Eterm)*old_heap_size,
+ area, area_size);
ASSERT(p->old_htop <= old_htop && old_htop <= p->old_hend);
p->old_htop = old_htop;
@@ -834,15 +1006,18 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
}
static int
-minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
+minor_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj, Uint *recl)
{
- Uint mature = HIGH_WATER(p) - HEAP_START(p);
+ Eterm *mature = p->abandoned_heap ? p->abandoned_heap : p->heap;
+ Uint mature_size = p->high_water - mature;
+ Uint size_before = young_gen_usage(p);
/*
* Allocate an old heap if we don't have one and if we'll need one.
*/
- if (OLD_HEAP(p) == NULL && mature != 0) {
+ if (OLD_HEAP(p) == NULL && mature_size != 0) {
Eterm* n_old;
/* Note: We choose a larger heap size than strictly needed,
@@ -850,7 +1025,7 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
* This improved Estone by more than 1200 estones on my computer
* (Ultra Sparc 10).
*/
- Uint new_sz = erts_next_heap_size(HEAP_TOP(p) - HEAP_START(p), 1);
+ Uint new_sz = erts_next_heap_size(size_before, 1);
/* Create new, empty old_heap */
n_old = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_OLD_HEAP,
@@ -866,41 +1041,32 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
*/
if (OLD_HEAP(p) &&
- ((mature <= OLD_HEND(p) - OLD_HTOP(p)) &&
- ((BIN_VHEAP_MATURE(p) < ( BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)))) &&
- ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) {
- ErlMessage *msgp;
- Uint size_after;
- Uint need_after;
- const Uint stack_size = STACK_SZ_ON_HEAP(p);
- const Uint size_before = MBUF_SIZE(p) + (HEAP_TOP(p) - HEAP_START(p));
- Uint new_sz = HEAP_SIZE(p) + MBUF_SIZE(p) + combined_message_size(p);
+ ((mature_size <= OLD_HEND(p) - OLD_HTOP(p)) &&
+ ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) {
+ Eterm *prev_old_htop;
+ Uint stack_size, size_after, adjust_size, need_after, new_sz, new_mature;
+
+ stack_size = p->hend - p->stop;
+ new_sz = stack_size + size_before;
new_sz = next_heap_size(p, new_sz, 0);
- do_minor(p, new_sz, objv, nobj);
+ prev_old_htop = p->old_htop;
+ do_minor(p, live_hf_end, (char *) mature, mature_size*sizeof(Eterm),
+ new_sz, objv, nobj);
+
+ if (p->flags & F_ON_HEAP_MSGQ)
+ move_msgq_to_heap(p);
- size_after = HEAP_TOP(p) - HEAP_START(p);
+ new_mature = p->old_htop - prev_old_htop;
+
+ size_after = new_mature;
+ size_after += HEAP_TOP(p) - HEAP_START(p) + p->mbuf_sz;
*recl += (size_before - size_after);
- /*
- * Copy newly received message onto the end of the new heap.
- */
- ErtsGcQuickSanityCheck(p);
- for (msgp = p->msg.first; msgp; msgp = msgp->next) {
- if (msgp->data.attached) {
- ErtsHeapFactory factory;
- erts_factory_proc_prealloc_init(&factory, p,
- erts_msg_attached_data_size(msgp));
- erts_move_msg_attached_data_to_heap(&factory, msgp);
- erts_factory_close(&factory);
- ErtsGcQuickSanityCheck(p);
- }
- }
ErtsGcQuickSanityCheck(p);
GEN_GCS(p)++;
need_after = ((HEAP_TOP(p) - HEAP_START(p))
- + erts_used_frag_sz(MBUF(p))
+ need
+ stack_size);
@@ -913,6 +1079,8 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
* the heap size is substantial, we don't want to shrink.
*/
+ adjust_size = 0;
+
if ((HEAP_SIZE(p) > 3000) && (4 * need_after < HEAP_SIZE(p)) &&
((HEAP_SIZE(p) > 8000) ||
(HEAP_SIZE(p) > (OLD_HEND(p) - OLD_HEAP(p))))) {
@@ -934,28 +1102,33 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
: next_heap_size(p, wanted, 0);
if (wanted < HEAP_SIZE(p)) {
shrink_new_heap(p, wanted, objv, nobj);
+ adjust_size = p->htop - p->heap;
}
- ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0));
- ASSERT(MBUF(p) == NULL);
- return 1; /* We are done. */
+ goto done;
}
if (HEAP_SIZE(p) >= need_after) {
/*
* The heap size turned out to be just right. We are done.
*/
- ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0));
- ASSERT(MBUF(p) == NULL);
- return 1;
+ goto done;
}
+
+ grow_new_heap(p, next_heap_size(p, need_after, 0), objv, nobj);
+ adjust_size = p->htop - p->heap;
+
+ done:
+ ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0));
+ ASSERT(MBUF(p) == NULL);
+
+ return gc_cost(size_after, adjust_size);
}
/*
- * Still not enough room after minor collection. Must force a major collection.
+ * Not enough room for a minor collection. Must force a major collection.
*/
- FLAGS(p) |= F_NEED_FULLSWEEP;
- return 0;
+ return -1;
}
/*
@@ -1009,7 +1182,9 @@ static ERTS_INLINE void offset_nstack(Process* p, Sint offs,
#endif /* HIPE */
static void
-do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
+do_minor(Process *p, ErlHeapFragment *live_hf_end,
+ char *mature, Uint mature_size,
+ Uint new_sz, Eterm* objv, int nobj)
{
Rootset rootset; /* Rootset for GC (stack, dictionary, etc). */
Roots* roots;
@@ -1018,17 +1193,24 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
Eterm* ptr;
Eterm val;
Eterm gval;
- char* heap = (char *) HEAP_START(p);
- Uint heap_size = (char *) HEAP_TOP(p) - heap;
- Uint mature_size = (char *) HIGH_WATER(p) - heap;
Eterm* old_htop = OLD_HTOP(p);
Eterm* n_heap;
+ char* oh = (char *) OLD_HEAP(p);
+ Uint oh_size = (char *) OLD_HTOP(p) - oh;
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MINOR GC: %p %p %p %p\n", p->common.id,
+ HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)));
n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP,
sizeof(Eterm)*new_sz);
- if (MBUF(p) != NULL) {
- n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj);
+ if (live_hf_end != ERTS_INVALID_HFRAG_PTR) {
+ /*
+ * Move heap frags that we know are completely live
+ * directly into the new young heap generation.
+ */
+ n_htop = collect_live_heap_frags(p, live_hf_end, n_heap, n_htop,
+ objv, nobj);
}
n = setup_rootset(p, objv, nobj, &rootset);
@@ -1051,9 +1233,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_BOXED(ptr,val,old_htop,g_ptr++);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
MOVE_BOXED(ptr,val,n_htop,g_ptr++);
} else {
g_ptr++;
@@ -1066,9 +1248,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
val = *ptr;
if (IS_MOVED_CONS(val)) { /* Moved */
*g_ptr++ = ptr[1];
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_CONS(ptr,val,old_htop,g_ptr++);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
MOVE_CONS(ptr,val,n_htop,g_ptr++);
} else {
g_ptr++;
@@ -1093,7 +1275,7 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
*/
if (mature_size == 0) {
- n_htop = sweep_one_area(n_heap, n_htop, heap, heap_size);
+ n_htop = sweep_new_heap(n_heap, n_htop, oh, oh_size);
} else {
Eterm* n_hp = n_heap;
Eterm* ptr;
@@ -1110,9 +1292,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*n_hp++ = val;
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_BOXED(ptr,val,old_htop,n_hp++);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
MOVE_BOXED(ptr,val,n_htop,n_hp++);
} else {
n_hp++;
@@ -1124,9 +1306,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
val = *ptr;
if (IS_MOVED_CONS(val)) {
*n_hp++ = ptr[1];
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_CONS(ptr,val,old_htop,n_hp++);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
MOVE_CONS(ptr,val,n_htop,n_hp++);
} else {
n_hp++;
@@ -1146,10 +1328,10 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
if (IS_MOVED_BOXED(val)) {
*origptr = val;
mb->base = binary_bytes(val);
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_BOXED(ptr,val,old_htop,origptr);
mb->base = binary_bytes(mb->orig);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(*origptr, ptr, oh, oh_size)) {
MOVE_BOXED(ptr,val,n_htop,origptr);
mb->base = binary_bytes(mb->orig);
}
@@ -1170,9 +1352,8 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
* may point to the old (soon to be deleted) new_heap.
*/
- if (OLD_HTOP(p) < old_htop) {
- old_htop = sweep_one_area(OLD_HTOP(p), old_htop, heap, heap_size);
- }
+ if (OLD_HTOP(p) < old_htop)
+ old_htop = sweep_new_heap(OLD_HTOP(p), old_htop, oh, oh_size);
OLD_HTOP(p) = old_htop;
HIGH_WATER(p) = n_htop;
@@ -1204,8 +1385,12 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
#endif
ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (void*)HEAP_START(p),
+ (p->abandoned_heap
+ ? p->abandoned_heap
+ : HEAP_START(p)),
HEAP_SIZE(p) * sizeof(Eterm));
+ p->abandoned_heap = NULL;
+ p->flags &= ~F_ABANDONED_HEAP_USE;
HEAP_START(p) = n_heap;
HEAP_TOP(p) = n_htop;
HEAP_SIZE(p) = new_sz;
@@ -1222,31 +1407,30 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
*/
static int
-major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
+major_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj, Uint *recl)
{
- Rootset rootset;
- Roots* roots;
- const Uint size_before = ((HEAP_TOP(p) - HEAP_START(p))
- + (OLD_HTOP(p) - OLD_HEAP(p))
- + MBUF_SIZE(p));
+ Uint size_before, size_after, stack_size;
Eterm* n_heap;
Eterm* n_htop;
- char* src = (char *) HEAP_START(p);
- Uint src_size = (char *) HEAP_TOP(p) - src;
char* oh = (char *) OLD_HEAP(p);
Uint oh_size = (char *) OLD_HTOP(p) - oh;
- Uint n;
- Uint new_sz;
- int done;
+ Uint new_sz, stk_sz;
+ int adjusted;
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MAJOR GC: %p %p %p %p\n", p->common.id,
+ HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)));
/*
* Do a fullsweep GC. First figure out the size of the heap
* to receive all live data.
*/
- new_sz = (HEAP_SIZE(p) + MBUF_SIZE(p)
- + combined_message_size(p)
- + (OLD_HTOP(p) - OLD_HEAP(p)));
+ size_before = young_gen_usage(p);
+ size_before += p->old_htop - p->old_heap;
+ stack_size = p->hend - p->stop;
+
+ new_sz = stack_size + size_before;
new_sz = next_heap_size(p, new_sz, 0);
/*
@@ -1260,13 +1444,76 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
n_htop = n_heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP,
sizeof(Eterm)*new_sz);
- /*
- * Get rid of heap fragments.
- */
+ if (live_hf_end != ERTS_INVALID_HFRAG_PTR) {
+ /*
+ * Move heap frags that we know are completely live
+ * directly into the heap.
+ */
+ n_htop = collect_live_heap_frags(p, live_hf_end, n_heap, n_htop,
+ objv, nobj);
+ }
- if (MBUF(p) != NULL) {
- n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj);
+ n_htop = full_sweep_heaps(p, 0, n_heap, n_htop, oh, oh_size, objv, nobj);
+
+ /* Move the stack to the end of the heap */
+ stk_sz = HEAP_END(p) - p->stop;
+ sys_memcpy(n_heap + new_sz - stk_sz, p->stop, stk_sz * sizeof(Eterm));
+ p->stop = n_heap + new_sz - stk_sz;
+
+#ifdef USE_VM_PROBES
+ if (HEAP_SIZE(p) != new_sz && DTRACE_ENABLED(process_heap_grow)) {
+ DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
+
+ dtrace_proc_str(p, pidbuf);
+ DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz);
}
+#endif
+
+ ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
+ (p->abandoned_heap
+ ? p->abandoned_heap
+ : HEAP_START(p)),
+ p->heap_sz * sizeof(Eterm));
+ p->abandoned_heap = NULL;
+ p->flags &= ~F_ABANDONED_HEAP_USE;
+ HEAP_START(p) = n_heap;
+ HEAP_TOP(p) = n_htop;
+ HEAP_SIZE(p) = new_sz;
+ HEAP_END(p) = n_heap + new_sz;
+ GEN_GCS(p) = 0;
+
+ HIGH_WATER(p) = HEAP_TOP(p);
+
+ remove_message_buffers(p);
+
+ if (p->flags & F_ON_HEAP_MSGQ)
+ move_msgq_to_heap(p);
+
+ ErtsGcQuickSanityCheck(p);
+
+ size_after = HEAP_TOP(p) - HEAP_START(p) + p->mbuf_sz;
+ *recl += size_before - size_after;
+
+ adjusted = adjust_after_fullsweep(p, need, objv, nobj);
+
+#ifdef HARDDEBUG
+ disallow_heap_frag_ref_in_heap(p);
+#endif
+ ErtsGcQuickSanityCheck(p);
+
+ return gc_cost(size_after, adjusted ? size_after : 0);
+}
+
+static Eterm *
+full_sweep_heaps(Process *p,
+ int hibernate,
+ Eterm *n_heap, Eterm* n_htop,
+ char *oh, Uint oh_size,
+ Eterm *objv, int nobj)
+{
+ Rootset rootset;
+ Roots *roots;
+ Uint n;
/*
* Copy all top-level terms directly referenced by the rootset to
@@ -1274,7 +1521,14 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
*/
n = setup_rootset(p, objv, nobj, &rootset);
- n_htop = fullsweep_nstack(p, n_htop);
+
+#ifdef HIPE
+ if (hibernate)
+ hipe_empty_nstack(p);
+ else
+ n_htop = fullsweep_nstack(p, n_htop);
+#endif
+
roots = rootset.roots;
while (n--) {
Eterm* g_ptr = roots->v;
@@ -1294,7 +1548,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
- } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
+ } else if (!erts_is_literal(gval, ptr)) {
MOVE_BOXED(ptr,val,n_htop,g_ptr++);
} else {
g_ptr++;
@@ -1307,7 +1561,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
val = *ptr;
if (IS_MOVED_CONS(val)) {
*g_ptr++ = ptr[1];
- } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
+ } else if (!erts_is_literal(gval, ptr)) {
MOVE_CONS(ptr,val,n_htop,g_ptr++);
} else {
g_ptr++;
@@ -1332,74 +1586,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
* until all is copied.
*/
- if (oh_size == 0) {
- n_htop = sweep_one_area(n_heap, n_htop, src, src_size);
- } else {
- Eterm* n_hp = n_heap;
-
- while (n_hp != n_htop) {
- Eterm* ptr;
- Eterm val;
- Eterm gval = *n_hp;
-
- switch (primary_tag(gval)) {
- case TAG_PRIMARY_BOXED: {
- ptr = boxed_val(gval);
- val = *ptr;
- if (IS_MOVED_BOXED(val)) {
- ASSERT(is_boxed(val));
- *n_hp++ = val;
- } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
- MOVE_BOXED(ptr,val,n_htop,n_hp++);
- } else {
- n_hp++;
- }
- break;
- }
- case TAG_PRIMARY_LIST: {
- ptr = list_val(gval);
- val = *ptr;
- if (IS_MOVED_CONS(val)) {
- *n_hp++ = ptr[1];
- } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
- MOVE_CONS(ptr,val,n_htop,n_hp++);
- } else {
- n_hp++;
- }
- break;
- }
- case TAG_PRIMARY_HEADER: {
- if (!header_is_thing(gval))
- n_hp++;
- else {
- if (header_is_bin_matchstate(gval)) {
- ErlBinMatchState *ms = (ErlBinMatchState*) n_hp;
- ErlBinMatchBuffer *mb = &(ms->mb);
- Eterm* origptr;
- origptr = &(mb->orig);
- ptr = boxed_val(*origptr);
- val = *ptr;
- if (IS_MOVED_BOXED(val)) {
- *origptr = val;
- mb->base = binary_bytes(*origptr);
- } else if (in_area(ptr, src, src_size) ||
- in_area(ptr, oh, oh_size)) {
- MOVE_BOXED(ptr,val,n_htop,origptr);
- mb->base = binary_bytes(*origptr);
- ptr = boxed_val(*origptr);
- val = *ptr;
- }
- }
- n_hp += (thing_arityval(gval)+1);
- }
- break;
- }
- default:
- n_hp++;
- break;
- }
- }
- }
+ n_htop = sweep_heaps(n_heap, n_htop, oh, oh_size);
if (MSO(p).first) {
sweep_off_heap(p, 1);
@@ -1412,75 +1599,13 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
OLD_HEAP(p) = OLD_HTOP(p) = OLD_HEND(p) = NULL;
}
- /* Move the stack to the end of the heap */
- n = HEAP_END(p) - p->stop;
- sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm));
- p->stop = n_heap + new_sz - n;
-
-#ifdef USE_VM_PROBES
- if (HEAP_SIZE(p) != new_sz && DTRACE_ENABLED(process_heap_grow)) {
- DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
-
- dtrace_proc_str(p, pidbuf);
- DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz);
- }
-#endif
-
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (void *) HEAP_START(p),
- (HEAP_END(p) - HEAP_START(p)) * sizeof(Eterm));
- HEAP_START(p) = n_heap;
- HEAP_TOP(p) = n_htop;
- HEAP_SIZE(p) = new_sz;
- HEAP_END(p) = n_heap + new_sz;
- GEN_GCS(p) = 0;
-
- HIGH_WATER(p) = HEAP_TOP(p);
-
- ErtsGcQuickSanityCheck(p);
-
- *recl += size_before - (HEAP_TOP(p) - HEAP_START(p));
-
- remove_message_buffers(p);
-
- {
- ErlMessage *msgp;
-
- /*
- * Copy newly received message onto the end of the new heap.
- */
- for (msgp = p->msg.first; msgp; msgp = msgp->next) {
- if (msgp->data.attached) {
- ErtsHeapFactory factory;
- erts_factory_proc_prealloc_init(&factory, p,
- erts_msg_attached_data_size(msgp));
- erts_move_msg_attached_data_to_heap(&factory, msgp);
- erts_factory_close(&factory);
- ErtsGcQuickSanityCheck(p);
- }
- }
- }
-
- if (MBUF(p)) {
- /* This is a very rare case when distributed messages copied above
- * contained maps so big they did not fit on the heap causing the
- * factory to create heap frags.
- * Solution: Trigger a minor gc (without tenuring)
- */
- HIGH_WATER(p) = HEAP_START(p);
- done = 0;
- } else {
- adjust_after_fullsweep(p, need, objv, nobj);
- done = 1;
- }
-
- ErtsGcQuickSanityCheck(p);
- return done;
+ return n_htop;
}
-static void
+static int
adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj)
{
+ int adjusted = 0;
Uint wanted, sz, need_after;
Uint stack_size = STACK_SZ_ON_HEAP(p);
@@ -1493,6 +1618,7 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj)
/* Too small - grow to match requested need */
sz = next_heap_size(p, need_after, 0);
grow_new_heap(p, sz, objv, nobj);
+ adjusted = 1;
} else if (3 * HEAP_SIZE(p) < 4 * need_after){
/* Need more than 75% of current, postpone to next GC.*/
FLAGS(p) |= F_HEAP_GROW;
@@ -1509,25 +1635,10 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj)
if (sz < HEAP_SIZE(p)) {
shrink_new_heap(p, sz, objv, nobj);
+ adjusted = 1;
}
}
-}
-
-/*
- * Return the size of all message buffers that are NOT linked in the
- * mbuf list.
- */
-static Uint
-combined_message_size(Process* p)
-{
- Uint sz;
- ErlMessage *msgp;
-
- for (sz = 0, msgp = p->msg.first; msgp; msgp = msgp->next) {
- if (msgp->data.attached)
- sz += erts_msg_attached_data_size(msgp);
- }
- return sz;
+ return adjusted;
}
/*
@@ -1540,6 +1651,10 @@ remove_message_buffers(Process* p)
free_message_buffer(MBUF(p));
MBUF(p) = NULL;
}
+ if (p->msg_frag) {
+ erts_cleanup_messages(p->msg_frag);
+ p->msg_frag = NULL;
+ }
MBUF_SIZE(p) = 0;
}
#ifdef HARDDEBUG
@@ -1551,64 +1666,6 @@ remove_message_buffers(Process* p)
* For performance reasons, we use _unchecked_list_val(), _unchecked_boxed_val(),
* and so on to avoid a function call.
*/
-
-static void
-disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj)
-{
- ErlHeapFragment* mbuf;
- ErlHeapFragment* qb;
- Eterm gval;
- Eterm* ptr;
- Eterm val;
-
- ASSERT(p->htop != NULL);
- mbuf = MBUF(p);
-
- while (nobj--) {
- gval = *objv;
-
- switch (primary_tag(gval)) {
-
- case TAG_PRIMARY_BOXED: {
- ptr = _unchecked_boxed_val(gval);
- val = *ptr;
- if (IS_MOVED_BOXED(val)) {
- ASSERT(is_boxed(val));
- objv++;
- } else {
- for (qb = mbuf; qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
- abort();
- }
- }
- objv++;
- }
- break;
- }
-
- case TAG_PRIMARY_LIST: {
- ptr = _unchecked_list_val(gval);
- val = *ptr;
- if (IS_MOVED_CONS(val)) {
- objv++;
- } else {
- for (qb = mbuf; qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
- abort();
- }
- }
- objv++;
- }
- break;
- }
-
- default: {
- objv++;
- break;
- }
- }
- }
-}
static void
disallow_heap_frag_ref_in_heap(Process* p)
@@ -1636,9 +1693,9 @@ disallow_heap_frag_ref_in_heap(Process* p)
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
ptr = _unchecked_boxed_val(val);
- if (!in_area(ptr, heap, heap_size)) {
+ if (!ErtsInArea(ptr, heap, heap_size)) {
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+ if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1646,9 +1703,9 @@ disallow_heap_frag_ref_in_heap(Process* p)
break;
case TAG_PRIMARY_LIST:
ptr = _unchecked_list_val(val);
- if (!in_area(ptr, heap, heap_size)) {
+ if (!ErtsInArea(ptr, heap, heap_size)) {
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+ if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1690,26 +1747,26 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
val = *hp++;
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
- ptr = (Eterm *) EXPAND_POINTER(val);
- if (!in_area(ptr, old_heap, old_heap_size)) {
- if (in_area(ptr, new_heap, new_heap_size)) {
+ ptr = (Eterm *) val;
+ if (!ErtsInArea(ptr, old_heap, old_heap_size)) {
+ if (ErtsInArea(ptr, new_heap, new_heap_size)) {
abort();
}
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+ if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
}
break;
case TAG_PRIMARY_LIST:
- ptr = (Eterm *) EXPAND_POINTER(val);
- if (!in_area(ptr, old_heap, old_heap_size)) {
- if (in_area(ptr, new_heap, new_heap_size)) {
+ ptr = (Eterm *) val;
+ if (!ErtsInArea(ptr, old_heap, old_heap_size)) {
+ if (ErtsInArea(ptr, new_heap, new_heap_size)) {
abort();
}
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+ if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1718,7 +1775,7 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
case TAG_PRIMARY_HEADER:
if (header_is_thing(val)) {
hp += _unchecked_thing_arityval(val);
- if (!in_area(hp, old_heap, old_heap_size+1)) {
+ if (!ErtsInArea(hp, old_heap, old_heap_size+1)) {
abort();
}
}
@@ -1728,66 +1785,30 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
}
#endif
-static Eterm*
-sweep_rootset(Rootset* rootset, Eterm* htop, char* src, Uint src_size)
+typedef enum {
+ ErtsSweepNewHeap,
+ ErtsSweepHeaps,
+ ErtsSweepLiteralArea
+} ErtsSweepType;
+
+static ERTS_FORCE_INLINE Eterm *
+sweep(Eterm *n_hp, Eterm *n_htop,
+ ErtsSweepType type,
+ char *oh, Uint ohsz,
+ char *src, Uint src_size)
{
- Roots* roots = rootset->roots;
- Uint n = rootset->num_roots;
Eterm* ptr;
- Eterm gval;
Eterm val;
+ Eterm gval;
- while (n--) {
- Eterm* g_ptr = roots->v;
- Uint g_sz = roots->sz;
-
- roots++;
- while (g_sz--) {
- gval = *g_ptr;
-
- switch (primary_tag(gval)) {
- case TAG_PRIMARY_BOXED: {
- ptr = boxed_val(gval);
- val = *ptr;
- if (IS_MOVED_BOXED(val)) {
- ASSERT(is_boxed(val));
- *g_ptr++ = val;
- } else if (in_area(ptr, src, src_size)) {
- MOVE_BOXED(ptr,val,htop,g_ptr++);
- } else {
- g_ptr++;
- }
- break;
- }
- case TAG_PRIMARY_LIST: {
- ptr = list_val(gval);
- val = *ptr;
- if (IS_MOVED_CONS(val)) {
- *g_ptr++ = ptr[1];
- } else if (in_area(ptr, src, src_size)) {
- MOVE_CONS(ptr,val,htop,g_ptr++);
- } else {
- g_ptr++;
- }
- break;
- }
-
- default:
- g_ptr++;
- break;
- }
- }
- }
- return htop;
-}
+#undef ERTS_IS_IN_SWEEP_AREA
-
-static Eterm*
-sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
-{
- Eterm* ptr;
- Eterm val;
- Eterm gval;
+#define ERTS_IS_IN_SWEEP_AREA(TPtr, Ptr) \
+ (type == ErtsSweepHeaps \
+ ? !erts_is_literal((TPtr), (Ptr)) \
+ : (type == ErtsSweepNewHeap \
+ ? ErtsInYoungGen((TPtr), (Ptr), oh, ohsz) \
+ : ErtsInArea((Ptr), src, src_size)))
while (n_hp != n_htop) {
ASSERT(n_hp < n_htop);
@@ -1799,7 +1820,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*n_hp++ = val;
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
MOVE_BOXED(ptr,val,n_htop,n_hp++);
} else {
n_hp++;
@@ -1811,7 +1832,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
val = *ptr;
if (IS_MOVED_CONS(val)) {
*n_hp++ = ptr[1];
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
MOVE_CONS(ptr,val,n_htop,n_hp++);
} else {
n_hp++;
@@ -1832,7 +1853,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
if (IS_MOVED_BOXED(val)) {
*origptr = val;
mb->base = binary_bytes(*origptr);
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ERTS_IS_IN_SWEEP_AREA(*origptr, ptr)) {
MOVE_BOXED(ptr,val,n_htop,origptr);
mb->base = binary_bytes(*origptr);
}
@@ -1847,10 +1868,41 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
}
}
return n_htop;
+#undef ERTS_IS_IN_SWEEP_AREA
+}
+
+static Eterm *
+sweep_new_heap(Eterm *n_hp, Eterm *n_htop, char* old_heap, Uint old_heap_size)
+{
+ return sweep(n_hp, n_htop,
+ ErtsSweepNewHeap,
+ old_heap, old_heap_size,
+ NULL, 0);
+}
+
+static Eterm *
+sweep_heaps(Eterm *n_hp, Eterm *n_htop, char* old_heap, Uint old_heap_size)
+{
+ return sweep(n_hp, n_htop,
+ ErtsSweepHeaps,
+ old_heap, old_heap_size,
+ NULL, 0);
+}
+
+static Eterm *
+sweep_literal_area(Eterm *n_hp, Eterm *n_htop,
+ char* old_heap, Uint old_heap_size,
+ char* src, Uint src_size)
+{
+ return sweep(n_hp, n_htop,
+ ErtsSweepLiteralArea,
+ old_heap, old_heap_size,
+ src, src_size);
}
static Eterm*
-sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint src_size)
+sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
+ char* src, Uint src_size)
{
while (heap_ptr < heap_end) {
Eterm* ptr;
@@ -1864,7 +1916,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*heap_ptr++ = val;
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ErtsInArea(ptr, src, src_size)) {
MOVE_BOXED(ptr,val,htop,heap_ptr++);
} else {
heap_ptr++;
@@ -1876,7 +1928,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
val = *ptr;
if (IS_MOVED_CONS(val)) {
*heap_ptr++ = ptr[1];
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ErtsInArea(ptr, src, src_size)) {
MOVE_CONS(ptr,val,htop,heap_ptr++);
} else {
heap_ptr++;
@@ -1897,7 +1949,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
if (IS_MOVED_BOXED(val)) {
*origptr = val;
mb->base = binary_bytes(*origptr);
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ErtsInArea(ptr, src, src_size)) {
MOVE_BOXED(ptr,val,htop,origptr);
mb->base = binary_bytes(*origptr);
}
@@ -1948,43 +2000,21 @@ move_one_area(Eterm* n_htop, char* src, Uint src_size)
*/
static Eterm*
-collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop,
- Eterm* objv, int nobj)
+collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end,
+ Eterm* n_hstart, Eterm* n_htop,
+ Eterm* objv, int nobj)
{
ErlHeapFragment* qb;
char* frag_begin;
Uint frag_size;
/*
- * We don't allow references to a heap fragments from the stack, heap,
- * or process dictionary.
- */
-#ifdef HARDDEBUG
- disallow_heap_frag_ref(p, n_htop, p->stop, STACK_START(p) - p->stop);
- if (p->dictionary != NULL) {
- disallow_heap_frag_ref(p, n_htop, p->dictionary->data, p->dictionary->used);
- }
- /* OTP-18: Actually we do allow references from heap to heap fragments now.
- This can happen when doing "binary_to_term" with a "fat" map contained
- in another term. A "fat" map is a hashmap with higher heap demand than
- first estimated by "binary_to_term" causing the factory to allocate
- additional heap (fragments) for the hashmap tree nodes.
- Run map_SUITE:t_gc_rare_map_overflow to provoke this.
-
- Inverted references like this does not matter however. The copy done
- below by move_one_area() with move markers in the fragments and the
- sweeping done later by the GC should make everything ok in the end.
- */
- /***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) {
@@ -1996,12 +2026,177 @@ collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop,
return n_htop;
}
+static ERTS_INLINE void
+copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap,
+ ErlHeapFragment *bp, Eterm *refs, int nrefs)
+{
+ Uint sz;
+ int i;
+ Sint offs;
+ struct erl_off_heap_header* oh;
+ Eterm *fhp, *hp;
+
+ OH_OVERHEAD(off_heap, bp->off_heap.overhead);
+ sz = bp->used_size;
+
+ fhp = bp->mem;
+ hp = *hpp;
+ offs = hp - fhp;
+
+ oh = NULL;
+ while (sz--) {
+ Uint cpy_sz;
+ Eterm val = *fhp++;
+
+ switch (primary_tag(val)) {
+ case TAG_PRIMARY_IMMED1:
+ *hp++ = val;
+ break;
+ case TAG_PRIMARY_LIST:
+ case TAG_PRIMARY_BOXED:
+ *hp++ = offset_ptr(val, offs);
+ break;
+ case TAG_PRIMARY_HEADER:
+ *hp++ = val;
+ switch (val & _HEADER_SUBTAG_MASK) {
+ case ARITYVAL_SUBTAG:
+ break;
+ case REFC_BINARY_SUBTAG:
+ case FUN_SUBTAG:
+ case EXTERNAL_PID_SUBTAG:
+ case EXTERNAL_PORT_SUBTAG:
+ case EXTERNAL_REF_SUBTAG:
+ oh = (struct erl_off_heap_header*) (hp-1);
+ cpy_sz = thing_arityval(val);
+ goto cpy_words;
+ default:
+ cpy_sz = header_arity(val);
+
+ cpy_words:
+ ASSERT(sz >= cpy_sz);
+ sz -= cpy_sz;
+ while (cpy_sz >= 8) {
+ cpy_sz -= 8;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ }
+ switch (cpy_sz) {
+ case 7: *hp++ = *fhp++;
+ case 6: *hp++ = *fhp++;
+ case 5: *hp++ = *fhp++;
+ case 4: *hp++ = *fhp++;
+ case 3: *hp++ = *fhp++;
+ case 2: *hp++ = *fhp++;
+ case 1: *hp++ = *fhp++;
+ default: break;
+ }
+ if (oh) {
+ /* Add to offheap list */
+ oh->next = off_heap->first;
+ off_heap->first = oh;
+ ASSERT(*hpp <= (Eterm*)oh);
+ ASSERT(hp > (Eterm*)oh);
+ oh = NULL;
+ }
+ break;
+ }
+ break;
+ }
+ }
+
+ ASSERT(bp->used_size == hp - *hpp);
+ *hpp = hp;
+
+ for (i = 0; i < nrefs; i++) {
+ if (is_not_immed(refs[i]))
+ refs[i] = offset_ptr(refs[i], offs);
+ }
+ bp->off_heap.first = NULL;
+}
+
+static void
+move_msgq_to_heap(Process *p)
+{
+ ErtsMessage **mpp = &p->msg.first;
+
+ while (*mpp) {
+ ErtsMessage *mp = *mpp;
+
+ if (mp->data.attached) {
+ ErlHeapFragment *bp;
+ ErtsHeapFactory factory;
+
+ erts_factory_proc_prealloc_init(&factory, p,
+ erts_msg_attached_data_size(mp));
+
+ if (is_non_value(ERL_MESSAGE_TERM(mp))) {
+ if (mp->data.dist_ext) {
+ ASSERT(mp->data.dist_ext->heap_size >= 0);
+ if (is_not_nil(ERL_MESSAGE_TOKEN(mp))) {
+ bp = erts_dist_ext_trailer(mp->data.dist_ext);
+ ERL_MESSAGE_TOKEN(mp) = copy_struct(ERL_MESSAGE_TOKEN(mp),
+ bp->used_size,
+ &factory.hp,
+ factory.off_heap);
+ erts_cleanup_offheap(&bp->off_heap);
+ }
+ ERL_MESSAGE_TERM(mp) = erts_decode_dist_ext(&factory,
+ mp->data.dist_ext);
+ erts_free_dist_ext_copy(mp->data.dist_ext);
+ mp->data.dist_ext = NULL;
+ }
+ }
+ else {
+
+ if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ bp = &mp->hfrag;
+ else
+ bp = mp->data.heap_frag;
+
+ if (bp->next)
+ erts_move_multi_frags(&factory.hp, factory.off_heap, bp,
+ mp->m, ERL_MESSAGE_REF_ARRAY_SZ, 0);
+ else
+ copy_one_frag(&factory.hp, factory.off_heap, bp,
+ mp->m, ERL_MESSAGE_REF_ARRAY_SZ);
+
+ if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
+ mp->data.heap_frag = NULL;
+ free_message_buffer(bp);
+ }
+ else {
+ ErtsMessage *tmp = erts_alloc_message(0, NULL);
+ sys_memcpy((void *) tmp->m, (void *) mp->m,
+ sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ);
+ tmp->next = mp->next;
+ if (p->msg.save == &mp->next)
+ p->msg.save = &tmp->next;
+ if (p->msg.last == &mp->next)
+ p->msg.last = &tmp->next;
+ *mpp = tmp;
+ mp->next = NULL;
+ erts_cleanup_messages(mp);
+ mp = tmp;
+ }
+ }
+
+ erts_factory_close(&factory);
+ }
+
+ mpp = &(*mpp)->next;
+ }
+}
+
static Uint
setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
{
- Uint avail;
Roots* roots;
- ErlMessage* mp;
Uint n;
n = 0;
@@ -2013,8 +2208,8 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
++n;
if (p->dictionary != NULL) {
- roots[n].v = p->dictionary->data;
- roots[n].sz = p->dictionary->used;
+ roots[n].v = ERTS_PD_START(p->dictionary);
+ roots[n].sz = ERTS_PD_SIZE(p->dictionary);
++n;
}
if (nobj > 0) {
@@ -2024,7 +2219,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
}
ASSERT((is_nil(p->seq_trace_token) ||
- is_tuple(follow_moved(p->seq_trace_token)) ||
+ is_tuple(follow_moved(p->seq_trace_token, (Eterm) 0)) ||
is_atom(p->seq_trace_token)));
if (is_not_immed(p->seq_trace_token)) {
roots[n].v = &p->seq_trace_token;
@@ -2042,7 +2237,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
is_internal_pid(ERTS_TRACER_PROC(p)) ||
is_internal_port(ERTS_TRACER_PROC(p)));
- ASSERT(is_pid(follow_moved(p->group_leader)));
+ ASSERT(is_pid(follow_moved(p->group_leader, (Eterm) 0)));
if (is_not_immed(p->group_leader)) {
roots[n].v = &p->group_leader;
roots[n].sz = 1;
@@ -2079,31 +2274,47 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
ASSERT(n <= rootset->size);
- mp = p->msg.first;
- avail = rootset->size - n;
- while (mp != NULL) {
- if (avail == 0) {
- Uint new_size = 2*rootset->size;
- if (roots == rootset->def) {
- roots = erts_alloc(ERTS_ALC_T_ROOTSET,
- new_size*sizeof(Roots));
- sys_memcpy(roots, rootset->def, sizeof(rootset->def));
- } else {
- roots = erts_realloc(ERTS_ALC_T_ROOTSET,
- (void *) roots,
- new_size*sizeof(Roots));
- }
+ switch (p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) {
+ case F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG:
+ (void) erts_move_messages_off_heap(p);
+ case F_OFF_HEAP_MSGQ:
+ break;
+ case F_OFF_HEAP_MSGQ_CHNG:
+ case 0: {
+ /*
+ * We do not have off heap message queue enabled, i.e. we
+ * need to add message queue to rootset...
+ */
+ ErtsMessage *mp;
+
+ /* Ensure large enough rootset... */
+ if (n + p->msg.len > rootset->size) {
+ Uint new_size = n + p->msg.len;
+ ERTS_GC_ASSERT(roots == rootset->def);
+ roots = erts_alloc(ERTS_ALC_T_ROOTSET,
+ new_size*sizeof(Roots));
+ sys_memcpy(roots, rootset->def, n*sizeof(Roots));
rootset->size = new_size;
- avail = new_size - n;
}
- if (mp->data.attached == NULL) {
- roots[n].v = mp->m;
- roots[n].sz = 2;
- n++;
- avail--;
+
+ for (mp = p->msg.first; mp; mp = mp->next) {
+
+ if (!mp->data.attached) {
+ /*
+ * Message may refer data on heap;
+ * add it to rootset...
+ */
+ roots[n].v = mp->m;
+ roots[n].sz = ERL_MESSAGE_REF_ARRAY_SZ;
+ n++;
+ }
}
- mp = mp->next;
+ break;
}
+ }
+
+ ASSERT(rootset->size >= n);
+
rootset->roots = roots;
rootset->num_roots = n;
return n;
@@ -2343,11 +2554,11 @@ sweep_off_heap(Process *p, int fullsweep)
*/
while (ptr) {
if (IS_MOVED_BOXED(ptr->thing_word)) {
- ASSERT(!in_area(ptr, oheap, oheap_sz));
+ ASSERT(!ErtsInArea(ptr, oheap, oheap_sz));
*prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word);
ASSERT(!IS_MOVED_BOXED(ptr->thing_word));
if (ptr->thing_word == HEADER_PROC_BIN) {
- int to_new_heap = !in_area(ptr, oheap, oheap_sz);
+ int to_new_heap = !ErtsInArea(ptr, oheap, oheap_sz);
ASSERT(to_new_heap == !seen_mature || (!to_new_heap && (seen_mature=1)));
if (to_new_heap) {
bin_vheap += ptr->size / sizeof(Eterm);
@@ -2361,7 +2572,7 @@ sweep_off_heap(Process *p, int fullsweep)
ptr = ptr->next;
}
}
- else if (!in_area(ptr, oheap, oheap_sz)) {
+ else if (!ErtsInArea(ptr, oheap, oheap_sz)) {
/* garbage */
switch (thing_subtag(ptr->thing_word)) {
case REFC_BINARY_SUBTAG:
@@ -2393,7 +2604,7 @@ sweep_off_heap(Process *p, int fullsweep)
* generational collection - keep objects in list.
*/
while (ptr) {
- ASSERT(in_area(ptr, oheap, oheap_sz));
+ ASSERT(ErtsInArea(ptr, oheap, oheap_sz));
ASSERT(!IS_MOVED_BOXED(ptr->thing_word));
if (ptr->thing_word == HEADER_PROC_BIN) {
BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/
@@ -2412,7 +2623,6 @@ sweep_off_heap(Process *p, int fullsweep)
}
BIN_VHEAP_SZ(p) = next_vheap_size(p, bin_vheap, BIN_VHEAP_SZ(p));
MSO(p).overhead = bin_vheap;
- BIN_VHEAP_MATURE(p) = bin_vheap;
/*
* If we got any shrink candidates, check them out.
@@ -2483,7 +2693,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
switch (primary_tag(val)) {
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
- if (in_area(ptr_val(val), area, area_size)) {
+ if (ErtsInArea(ptr_val(val), area, area_size)) {
*hp = offset_ptr(val, offs);
}
hp++;
@@ -2505,7 +2715,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
{
struct erl_off_heap_header* oh = (struct erl_off_heap_header*) hp;
- if (in_area(oh->next, area, area_size)) {
+ if (ErtsInArea(oh->next, area, area_size)) {
Eterm** uptr = (Eterm **) (void *) &oh->next;
*uptr += offs; /* Patch the mso chain */
}
@@ -2515,7 +2725,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
{
ErlBinMatchState *ms = (ErlBinMatchState*) hp;
ErlBinMatchBuffer *mb = &(ms->mb);
- if (in_area(ptr_val(mb->orig), area, area_size)) {
+ if (ErtsInArea(ptr_val(mb->orig), area, area_size)) {
mb->orig = offset_ptr(mb->orig, offs);
mb->base = binary_bytes(mb->orig);
}
@@ -2545,7 +2755,7 @@ offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
switch (primary_tag(val)) {
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
- if (in_area(ptr_val(val), area, area_size)) {
+ if (ErtsInArea(ptr_val(val), area, area_size)) {
*hp = offset_ptr(val, offs);
}
hp++;
@@ -2560,7 +2770,7 @@ offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
static void
offset_off_heap(Process* p, Sint offs, char* area, Uint area_size)
{
- if (MSO(p).first && in_area((Eterm *)MSO(p).first, area, area_size)) {
+ if (MSO(p).first && ErtsInArea((Eterm *)MSO(p).first, area, area_size)) {
Eterm** uptr = (Eterm**) (void *) &MSO(p).first;
*uptr += offs;
}
@@ -2572,35 +2782,39 @@ offset_off_heap(Process* p, Sint offs, char* area, Uint area_size)
static void
offset_mqueue(Process *p, Sint offs, char* area, Uint area_size)
{
- ErlMessage* mp = p->msg.first;
-
- while (mp != NULL) {
- Eterm mesg = ERL_MESSAGE_TERM(mp);
- if (is_value(mesg)) {
- switch (primary_tag(mesg)) {
- case TAG_PRIMARY_LIST:
- case TAG_PRIMARY_BOXED:
- if (in_area(ptr_val(mesg), area, area_size)) {
- ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs);
+ ErtsMessage* mp = p->msg.first;
+
+ if ((p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) != F_OFF_HEAP_MSGQ) {
+
+ while (mp != NULL) {
+ Eterm mesg = ERL_MESSAGE_TERM(mp);
+ if (is_value(mesg)) {
+ switch (primary_tag(mesg)) {
+ case TAG_PRIMARY_LIST:
+ case TAG_PRIMARY_BOXED:
+ if (ErtsInArea(ptr_val(mesg), area, area_size)) {
+ ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs);
+ }
+ break;
}
- break;
}
- }
- mesg = ERL_MESSAGE_TOKEN(mp);
- if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) {
- ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs);
- }
+ mesg = ERL_MESSAGE_TOKEN(mp);
+ if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) {
+ ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs);
+ }
#ifdef USE_VM_PROBES
- mesg = ERL_MESSAGE_DT_UTAG(mp);
- if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) {
- ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs);
- }
+ mesg = ERL_MESSAGE_DT_UTAG(mp);
+ if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) {
+ ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs);
+ }
#endif
- ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) ||
- is_tuple(ERL_MESSAGE_TOKEN(mp)) ||
- is_atom(ERL_MESSAGE_TOKEN(mp))));
- mp = mp->next;
+ ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) ||
+ is_tuple(ERL_MESSAGE_TOKEN(mp)) ||
+ is_atom(ERL_MESSAGE_TOKEN(mp))));
+ mp = mp->next;
+ }
+
}
}
@@ -2609,8 +2823,8 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size,
Eterm* objv, int nobj)
{
if (p->dictionary) {
- offset_heap(p->dictionary->data,
- p->dictionary->used,
+ offset_heap(ERTS_PD_START(p->dictionary),
+ ERTS_PD_SIZE(p->dictionary),
offs, area, area_size);
}
@@ -2659,7 +2873,7 @@ reply_gc_info(void *vgcirp)
Eterm **hpp;
Uint sz, *szp;
ErlOffHeap *ohp = NULL;
- ErlHeapFragment *bp = NULL;
+ ErtsMessage *mp = NULL;
ASSERT(esdp);
@@ -2685,12 +2899,13 @@ reply_gc_info(void *vgcirp)
if (hpp)
break;
- hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
+
szp = NULL;
hpp = &hp;
}
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (gcirp->req_sched == esdp->no)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -2737,41 +2952,105 @@ erts_gc_info_request(Process *c_p)
return ref;
}
+Eterm
+erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp)
+{
+ ERTS_DECL_AM(bin_vheap_size);
+ ERTS_DECL_AM(bin_vheap_block_size);
+ ERTS_DECL_AM(bin_old_vheap_size);
+ ERTS_DECL_AM(bin_old_vheap_block_size);
+ Eterm tags[] = {
+ /* If you increase the number of elements here, make sure to update
+ any call sites as they may have stack allocations that depend
+ on the number of elements here. */
+ am_old_heap_block_size,
+ am_heap_block_size,
+ am_mbuf_size,
+ am_recent_size,
+ am_stack_size,
+ am_old_heap_size,
+ am_heap_size,
+ AM_bin_vheap_size,
+ AM_bin_vheap_block_size,
+ AM_bin_old_vheap_size,
+ AM_bin_old_vheap_block_size
+ };
+ UWord values[] = {
+ OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0,
+ HEAP_SIZE(p),
+ MBUF_SIZE(p),
+ HIGH_WATER(p) - HEAP_START(p),
+ STACK_START(p) - p->stop,
+ OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0,
+ HEAP_TOP(p) - HEAP_START(p),
+ MSO(p).overhead,
+ BIN_VHEAP_SZ(p),
+ BIN_OLD_VHEAP(p),
+ BIN_OLD_VHEAP_SZ(p)
+ };
+
+ Eterm res = THE_NON_VALUE;
+
+ ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(*tags));
+ ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == ERTS_PROCESS_GC_INFO_MAX_TERMS);
+
+ res = erts_bld_atom_uword_2tup_list(hpp,
+ sizep,
+ sizeof(values)/sizeof(*values),
+ tags,
+ values);
+
+ return res;
+}
+
#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
static int
within2(Eterm *ptr, Process *p, Eterm *real_htop)
{
- ErlHeapFragment* bp = MBUF(p);
- ErlMessage* mp = p->msg.first;
- Eterm *htop = real_htop ? real_htop : HEAP_TOP(p);
+ ErlHeapFragment* bp;
+ ErtsMessage* mp;
+ Eterm *htop, *heap;
+
+ if (p->abandoned_heap)
+ ERTS_GET_ORIG_HEAP(p, heap, htop);
+ else {
+ heap = p->heap;
+ htop = real_htop ? real_htop : HEAP_TOP(p);
+ }
if (OLD_HEAP(p) && (OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p))) {
return 1;
}
- if (HEAP_START(p) <= ptr && ptr < htop) {
+ if (heap <= ptr && ptr < htop) {
return 1;
}
- while (bp != NULL) {
- if (bp->mem <= ptr && ptr < bp->mem + bp->used_size) {
- return 1;
- }
- bp = bp->next;
- }
+
+ mp = p->msg_frag;
+ bp = p->mbuf;
+
+ if (bp)
+ goto search_heap_frags;
+
while (mp) {
- if (mp->data.attached) {
- ErlHeapFragment *hfp;
- if (is_value(ERL_MESSAGE_TERM(mp)))
- hfp = mp->data.heap_frag;
- else if (is_not_nil(ERL_MESSAGE_TOKEN(mp)))
- hfp = erts_dist_ext_trailer(mp->data.dist_ext);
- else
- hfp = NULL;
- if (hfp && hfp->mem <= ptr && ptr < hfp->mem + hfp->used_size)
+
+ if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ bp = &mp->hfrag;
+ else
+ bp = mp->data.heap_frag;
+
+ mp = mp->next;
+
+ search_heap_frags:
+
+ while (bp) {
+ if (bp->mem <= ptr && ptr < bp->mem + bp->used_size) {
return 1;
+ }
+ bp = bp->next;
}
- mp = mp->next;
}
+
return 0;
}
@@ -2793,11 +3072,11 @@ do { \
__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)
{
@@ -2826,7 +3105,7 @@ erts_check_off_heap2(Process *p, Eterm *htop)
}
ERTS_CHK_OFFHEAP_ASSERT(refc >= 1);
#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST
- ERTS_CHK_OFFHEAP_ASSERT(!(u.hdr->thing_word & ERTS_EXTERNAL_VISITED_BIT));
+ ERTS_CHK_OFFHEAP_ASSERT(!(u.hdr->thing_word & ERTS_OFFHEAP_VISITED_BIT));
u.hdr->thing_word |= ERTS_OFFHEAP_VISITED_BIT;
#endif
if (old) {
@@ -2839,7 +3118,7 @@ erts_check_off_heap2(Process *p, Eterm *htop)
}
}
-#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_EXTERNAL_LIST
+#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST
for (u.hdr = MSO(p).first; u.hdr; u.hdr = u.hdr->next)
u.hdr->thing_word &= ~ERTS_OFFHEAP_VISITED_BIT;
#endif
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index ecd1bf4d22..2cedd9361f 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -69,17 +69,18 @@ do { \
while (nelts--) *HTOP++ = *PTR++; \
} while(0)
-#define in_area(ptr,start,nbytes) \
- ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
-
#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
int within(Eterm *ptr, Process *p);
#endif
-ERTS_GLB_INLINE Eterm follow_moved(Eterm term);
+#define ErtsInYoungGen(TPtr, Ptr, OldHeap, OldHeapSz) \
+ (!erts_is_literal((TPtr), (Ptr)) \
+ & !ErtsInArea((Ptr), (OldHeap), (OldHeapSz)))
+
+ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
+ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag)
{
Eterm* ptr;
switch (primary_tag(term)) {
@@ -87,17 +88,18 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
break;
case TAG_PRIMARY_BOXED:
ptr = boxed_val(term);
- if (IS_MOVED_BOXED(*ptr)) term = *ptr;
+ if (IS_MOVED_BOXED(*ptr)) term = (*ptr) | xptr_tag;
break;
case TAG_PRIMARY_LIST:
ptr = list_val(term);
- if (IS_MOVED_CONS(ptr[0])) term = ptr[1];
+ if (IS_MOVED_CONS(ptr[0])) term = (ptr[1]) | xptr_tag;
break;
default:
ASSERT(!"strange tag in follow_moved");
}
return term;
}
+
#endif
#endif /* ERL_GC_C__ || HIPE_GC_C__ */
@@ -106,6 +108,23 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
* Global exported
*/
+#define ERTS_IS_GC_DESIRED_INTERNAL(Proc, HTop, STop) \
+ ((((STop) - (HTop) < (Proc)->mbuf_sz)) \
+ | ((Proc)->off_heap.overhead > (Proc)->bin_vheap_sz) \
+ | !!((Proc)->flags & F_FORCE_GC))
+
+#define ERTS_IS_GC_DESIRED(Proc) \
+ ERTS_IS_GC_DESIRED_INTERNAL((Proc), (Proc)->htop, (Proc)->stop)
+
+#define ERTS_FORCE_GC_INTERNAL(Proc, FCalls) \
+ do { \
+ (Proc)->flags |= F_FORCE_GC; \
+ ERTS_VBUMP_ALL_REDS_INTERNAL((Proc), (FCalls)); \
+ } while (0)
+
+#define ERTS_FORCE_GC(Proc) \
+ ERTS_FORCE_GC_INTERNAL((Proc), (Proc)->fcalls)
+
extern Uint erts_test_long_gc_sleep;
typedef struct {
@@ -113,10 +132,18 @@ typedef struct {
Uint64 garbage_cols;
} ErtsGCInfo;
+#define ERTS_PROCESS_GC_INFO_MAX_TERMS (11) /* number of elements in process_gc_info*/
+#define ERTS_PROCESS_GC_INFO_MAX_SIZE \
+ (ERTS_PROCESS_GC_INFO_MAX_TERMS * (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE))
+Eterm erts_process_gc_info(struct process*, Uint *, Eterm **);
+
void erts_gc_info(ErtsGCInfo *gcip);
void erts_init_gc(void);
-int erts_garbage_collect(struct process*, int, Eterm*, int);
+int erts_garbage_collect_nobump(struct process*, int, Eterm*, int);
+void erts_garbage_collect(struct process*, int, Eterm*, int);
void erts_garbage_collect_hibernate(struct process* p);
+Eterm erts_gc_after_bif_call_lhf(struct process* p, ErlHeapFragment *live_hf_end,
+ Eterm result, Eterm* regs, Uint arity);
Eterm erts_gc_after_bif_call(struct process* p, Eterm result, Eterm* regs, Uint arity);
void erts_garbage_collect_literals(struct process* p, Eterm* literals,
Uint lit_size,
diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c
index fb6d249145..491d2f8c84 100644
--- a/erts/emulator/beam/erl_hl_timer.c
+++ b/erts/emulator/beam/erl_hl_timer.c
@@ -1245,7 +1245,9 @@ hlt_bif_timer_timeout(ErtsHLTimer *tmr, Uint32 roflgs)
* the middle of tree destruction).
*/
if (!ERTS_PROC_IS_EXITING(proc)) {
- erts_queue_message(proc, &proc_locks, tmr->btm.bp,
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = tmr->btm.bp;
+ erts_queue_message(proc, &proc_locks, mp,
tmr->btm.message, NIL);
erts_smp_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_SEND);
queued_message = 1;
@@ -1926,36 +1928,31 @@ access_sched_local_btm(Process *c_p, Eterm pid,
if (proc) {
Uint hsz;
- ErlOffHeap *ohp;
- ErlHeapFragment* bp;
+ ErtsMessage *mp;
Eterm *hp, msg, ref, result;
+ ErlOffHeap *ohp;
+ Uint32 *refn;
#ifdef ERTS_HLT_DEBUG
Eterm *hp_end;
#endif
- hsz = 3; /* 2-tuple */
- if (!async)
- hsz += REF_THING_SIZE;
+ hsz = REF_THING_SIZE;
+ if (async) {
+ refn = trefn; /* timer ref */
+ hsz += 4; /* 3-tuple */
+ }
else {
- if (is_non_value(tref) || proc != c_p)
- hsz += REF_THING_SIZE;
- hsz += 1; /* upgrade to 3-tuple */
+ refn = rrefn; /* request ref */
+ hsz += 3; /* 2-tuple */
}
+
+ ERTS_HLT_ASSERT(refn);
+
if (time_left > (Sint64) MAX_SMALL)
hsz += ERTS_SINT64_HEAP_SIZE(time_left);
- if (proc == c_p) {
- bp = NULL;
- ohp = NULL;
- hp = HAlloc(c_p, hsz);
- }
- else {
- hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- proc,
- &proc_locks);
- }
+ mp = erts_alloc_message_heap(proc, &proc_locks,
+ hsz, &hp, &ohp);
#ifdef ERTS_HLT_DEBUG
hp_end = hp + hsz;
@@ -1968,35 +1965,22 @@ access_sched_local_btm(Process *c_p, Eterm pid,
else
result = erts_sint64_to_big(time_left, &hp);
- if (!async) {
- write_ref_thing(hp,
- rrefn[0],
- rrefn[1],
- rrefn[2]);
- ref = make_internal_ref(hp);
- hp += REF_THING_SIZE;
- msg = TUPLE2(hp, ref, result);
+ write_ref_thing(hp,
+ refn[0],
+ refn[1],
+ refn[2]);
+ ref = make_internal_ref(hp);
+ hp += REF_THING_SIZE;
- ERTS_HLT_ASSERT(hp + 3 == hp_end);
- }
- else {
- Eterm tag = cancel ? am_cancel_timer : am_read_timer;
- if (is_value(tref) && proc == c_p)
- ref = tref;
- else {
- write_ref_thing(hp,
- trefn[0],
- trefn[1],
- trefn[2]);
- ref = make_internal_ref(hp);
- hp += REF_THING_SIZE;
- }
- msg = TUPLE3(hp, tag, ref, result);
+ msg = (async
+ ? TUPLE3(hp, (cancel
+ ? am_cancel_timer
+ : am_read_timer), ref, result)
+ : TUPLE2(hp, ref, result));
- ERTS_HLT_ASSERT(hp + 4 == hp_end);
+ ERTS_HLT_ASSERT(hp + (async ? 4 : 3) == hp_end);
- }
- erts_queue_message(proc, &proc_locks, bp, msg, NIL);
+ erts_queue_message(proc, &proc_locks, mp, msg, NIL);
if (c_p)
proc_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -2034,7 +2018,7 @@ bif_timer_access_request(void *vreq)
static int
try_access_sched_remote_btm(ErtsSchedulerData *esdp,
Process *c_p, Uint32 sid,
- Eterm tref, Uint32 *trefn,
+ Uint32 *trefn,
int async, int cancel,
int info, Eterm *resp)
{
@@ -2093,21 +2077,31 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp,
}
}
else {
- Eterm tag, res, msg;
+ ErtsMessage *mp;
+ Eterm tag, res, msg, tref;
Uint hsz;
Eterm *hp;
ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN;
+ ErlOffHeap *ohp;
- hsz = 4;
+ hsz = 4 + REF_THING_SIZE;
if (time_left > (Sint64) MAX_SMALL)
hsz += ERTS_SINT64_HEAP_SIZE(time_left);
- hp = HAlloc(c_p, hsz);
+ mp = erts_alloc_message_heap(c_p, &proc_locks,
+ hsz, &hp, &ohp);
if (cancel)
tag = am_cancel_timer;
else
tag = am_read_timer;
+ write_ref_thing(hp,
+ trefn[0],
+ trefn[1],
+ trefn[2]);
+ tref = make_internal_ref(hp);
+ hp += REF_THING_SIZE;
+
if (time_left < 0)
res = am_false;
else if (time_left <= (Sint64) MAX_SMALL)
@@ -2117,7 +2111,7 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp,
msg = TUPLE3(hp, tag, tref, res);
- erts_queue_message(c_p, &proc_locks, NULL, msg, NIL);
+ erts_queue_message(c_p, &proc_locks, mp, msg, NIL);
proc_locks &= ~ERTS_PROC_LOCK_MAIN;
if (proc_locks)
@@ -2158,8 +2152,8 @@ access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info)
info);
ERTS_BIF_PREP_RET(ret, res);
}
- else if (try_access_sched_remote_btm(esdp, c_p, sid,
- tref, trefn,
+ else if (try_access_sched_remote_btm(esdp, c_p,
+ sid, trefn,
async, cancel,
info, &res)) {
ERTS_BIF_PREP_RET(ret, res);
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index d9c3b0dcf4..67089df863 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -91,11 +91,6 @@ const int etp_arch_bits = 32;
#else
# error "Not 64-bit, nor 32-bit arch"
#endif
-#if HALFWORD_HEAP
-const int etp_halfword = 1;
-#else
-const int etp_halfword = 0;
-#endif
#ifdef HIPE
const int etp_hipe = 1;
#else
@@ -157,7 +152,7 @@ volatile int erts_writing_erl_crash_dump = 0;
int erts_initialized = 0;
#if defined(USE_THREADS) && !defined(ERTS_SMP)
-static erts_tid_t main_thread;
+erts_tid_t erts_main_thread;
#endif
int erts_use_sender_punish;
@@ -197,7 +192,7 @@ Uint32 verbose; /* See erl_debug.h for information about verbose */
int erts_atom_table_size = ATOM_LIMIT; /* Maximum number of atoms */
-int erts_pd_initial_size = 10;
+int erts_pd_initial_size = 8; /* must be power of 2 */
int erts_modified_timing_level;
@@ -393,11 +388,13 @@ erl_init(int ncpu,
erts_mseg_late_init(); /* Must be after timer (erts_init_time()) and thread
initializations */
#endif
+ erl_sys_late_init();
#ifdef HIPE
hipe_mode_switch_init(); /* Must be after init_load/beam_catches/init */
#endif
packet_parser_init();
erl_nif_init();
+ erts_msacc_init();
}
static Eterm
@@ -436,13 +433,36 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char**
hp += 2;
args = CONS(hp, env, args);
- so.flags = SPO_SYSTEM_PROC;
+ so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC;
res = erl_create_process(&parent, start_mod, am_start, args, &so);
erts_smp_proc_unlock(&parent, ERTS_PROC_LOCK_MAIN);
erts_cleanup_empty_process(&parent);
return res;
}
+static Eterm
+erl_system_process_otp(Eterm parent_pid, char* modname)
+{
+ Eterm start_mod;
+ Process* parent;
+ ErlSpawnOpts so;
+ Eterm res;
+
+ start_mod = erts_atom_put((byte *) modname, sys_strlen(modname), ERTS_ATOM_ENC_LATIN1, 1);
+ if (erts_find_function(start_mod, am_start, 0,
+ erts_active_code_ix()) == NULL) {
+ erl_exit(5, "No function %s:start/0\n", modname);
+ }
+
+ parent = erts_pid2proc(NULL, 0, parent_pid, ERTS_PROC_LOCK_MAIN);
+
+ so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC;
+ res = erl_create_process(parent, start_mod, am_start, NIL, &so);
+ erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_MAIN);
+ return res;
+}
+
+
Eterm
erts_preloaded(Process* p)
{
@@ -635,6 +655,8 @@ void erts_usage(void)
erts_fprintf(stderr, "-W<i|w|e> set error logger warnings mapping,\n");
erts_fprintf(stderr, " see error_logger documentation for details\n");
+ erts_fprintf(stderr, "-xmqd val set default message queue data flag for processes,\n");
+ erts_fprintf(stderr, " valid values are: off_heap | on_heap | mixed\n");
erts_fprintf(stderr, "-zdbbl size set the distribution buffer busy limit in kilobytes\n");
erts_fprintf(stderr, " valid range is [1-%d]\n", INT_MAX/1024);
erts_fprintf(stderr, "-zdntgc time set delayed node table gc in seconds\n");
@@ -723,6 +745,10 @@ early_init(int *argc, char **argv) /*
char envbuf[21]; /* enough for any 64-bit integer */
size_t envbufsz;
+#if defined(USE_THREADS) && !defined(ERTS_SMP)
+ erts_main_thread = erts_thr_self();
+#endif
+
erts_save_emu_args(*argc, argv);
erts_sched_compact_load = 1;
@@ -776,9 +802,6 @@ early_init(int *argc, char **argv) /*
(erts_aint32_t) ((Uint16) -1));
erts_pre_init_process();
-#if defined(USE_THREADS) && !defined(ERTS_SMP)
- main_thread = erts_thr_self();
-#endif
/*
* We need to know the number of schedulers to use before we
@@ -1172,6 +1195,7 @@ early_init(int *argc, char **argv) /*
erts_thr_late_init(&elid);
}
#endif
+ erts_msacc_early_init();
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_late_init();
@@ -1236,6 +1260,7 @@ erl_start(int argc, char **argv)
ErtsTimeWarpMode time_warp_mode;
int node_tab_delete_delay = ERTS_NODE_TAB_DELAY_GC_DEFAULT;
ErtsDbSpinCount db_spin_count = ERTS_DB_SPNCNT_NORMAL;
+ Eterm otp_ring0_pid;
set_default_time_adj(&time_correction,
&time_warp_mode);
@@ -1405,6 +1430,7 @@ erl_start(int argc, char **argv)
case 't': verbose |= DEBUG_THREADS; break;
case 'p': verbose |= DEBUG_PROCESSES; break;
case 'm': verbose |= DEBUG_MESSAGES; break;
+ case 'c': verbose |= DEBUG_SHCOPY; break;
default : erts_fprintf(stderr,"Unknown verbose option: %c\n",*ch);
}
}
@@ -1417,6 +1443,7 @@ erl_start(int argc, char **argv)
if (verbose & DEBUG_THREADS) erts_printf("THREADS ");
if (verbose & DEBUG_PROCESSES) erts_printf("PROCESSES ");
if (verbose & DEBUG_MESSAGES) erts_printf("MESSAGES ");
+ if (verbose & DEBUG_SHCOPY) erts_printf("SHCOPY ");
erts_printf("\n");
#else
erts_fprintf(stderr, "warning: -v (only in debug compiled code)\n");
@@ -1479,7 +1506,7 @@ erl_start(int argc, char **argv)
VERBOSE(DEBUG_SYSTEM, ("using minimum heap size %d\n", H_MIN_SIZE));
} else if (has_prefix("pds", sub_param)) {
arg = get_arg(sub_param+3, argv[i+1], &i);
- if ((erts_pd_initial_size = atoi(arg)) <= 0) {
+ if (!erts_pd_set_initial_size(atoi(arg))) {
erts_fprintf(stderr, "bad initial process dictionary size %s\n", arg);
erts_usage();
}
@@ -2020,6 +2047,32 @@ erl_start(int argc, char **argv)
}
break;
+ case 'x': {
+ char *sub_param = argv[i]+2;
+ if (has_prefix("mqd", sub_param)) {
+ arg = get_arg(sub_param+3, argv[i+1], &i);
+ if (sys_strcmp(arg, "mixed") == 0)
+ erts_default_spo_flags &= ~(SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ);
+ else if (sys_strcmp(arg, "on_heap") == 0) {
+ erts_default_spo_flags &= ~SPO_OFF_HEAP_MSGQ;
+ erts_default_spo_flags |= SPO_ON_HEAP_MSGQ;
+ }
+ else if (sys_strcmp(arg, "off_heap") == 0) {
+ erts_default_spo_flags &= ~SPO_ON_HEAP_MSGQ;
+ erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ;
+ }
+ else {
+ erts_fprintf(stderr,
+ "Invalid message_queue_data flag: %s\n", arg);
+ erts_usage();
+ }
+ } else {
+ erts_fprintf(stderr, "bad -x option %s\n", argv[i]);
+ erts_usage();
+ }
+ break;
+ }
+
case 'z': {
char *sub_param = argv[i]+2;
@@ -2073,7 +2126,8 @@ erl_start(int argc, char **argv)
"Invalid ets busy wait threshold: %s\n", arg);
erts_usage();
}
- } else {
+ }
+ else {
erts_fprintf(stderr, "bad -z option %s\n", argv[i]);
erts_usage();
}
@@ -2156,8 +2210,10 @@ erl_start(int argc, char **argv)
erts_initialized = 1;
- (void) erl_first_process_otp("otp_ring0", NULL, 0,
- boot_argc, boot_argv);
+ otp_ring0_pid = erl_first_process_otp("otp_ring0", NULL, 0,
+ boot_argc, boot_argv);
+
+ (void) erl_system_process_otp(otp_ring0_pid, "erts_code_purger");
#ifdef ERTS_SMP
erts_start_schedulers();
@@ -2167,6 +2223,7 @@ erl_start(int argc, char **argv)
#else
{
ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ erts_msacc_init_thread("scheduler", 1, 1);
erts_thr_set_main_status(1, 1);
#if ERTS_USE_ASYNC_READY_Q
esdp->aux_work_data.async_ready.queue
@@ -2232,7 +2289,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;
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 3b3b247020..598bf84c0b 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -113,9 +113,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "environ", NULL },
#endif
{ "efile_drv", "address" },
-#if defined(ENABLE_CHILD_WAITER_THREAD) || defined(ERTS_SMP)
- { "child_status", NULL },
-#endif
{ "drv_ev_state_grow", NULL, },
{ "drv_ev_state", "address" },
{ "safe_hash", "address" },
@@ -140,6 +137,8 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "mmap_init_atoms", NULL },
{ "drv_tsd", NULL },
{ "async_enq_mtx", NULL },
+ { "msacc_list_mutex", NULL },
+ { "msacc_unmanaged_mutex", NULL },
#ifdef ERTS_SMP
{ "atom_tab", NULL },
{ "misc_op_list_pre_alloc_lock", "address" },
@@ -156,9 +155,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "instr", NULL },
{ "alcu_allocator", "index" },
{ "mseg", NULL },
-#if HALFWORD_HEAP
- { "pmmap", NULL },
-#endif
#ifdef ERTS_SMP
{ "port_task_pre_alloc_lock", "address" },
{ "proclist_pre_alloc_lock", "address" },
diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c
index ff2a355309..d0ffb11e79 100644
--- a/erts/emulator/beam/erl_map.c
+++ b/erts/emulator/beam/erl_map.c
@@ -172,26 +172,22 @@ BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) {
*/
const Eterm *
-#if HALFWORD_HEAP
-erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base)
-#else
erts_maps_get(Eterm key, Eterm map)
-#endif
{
Uint32 hx;
- if (is_flatmap_rel(map, map_base)) {
+ if (is_flatmap(map)) {
Eterm *ks, *vs;
flatmap_t *mp;
Uint n, i;
- mp = (flatmap_t *)flatmap_val_rel(map, map_base);
+ mp = (flatmap_t *)flatmap_val(map);
n = flatmap_get_size(mp);
if (n == 0) {
return NULL;
}
- ks = (Eterm *)tuple_val_rel(mp->keys, map_base) + 1;
+ ks = (Eterm *)tuple_val(mp->keys) + 1;
vs = flatmap_get_values(mp);
if (is_immed(key)) {
@@ -203,16 +199,16 @@ erts_maps_get(Eterm key, Eterm map)
}
for (i = 0; i < n; i++) {
- if (eq_rel(ks[i], map_base, key, NULL)) {
+ if (EQ(ks[i], key)) {
return &vs[i];
}
}
return NULL;
}
- ASSERT(is_hashmap_rel(map, map_base));
+ ASSERT(is_hashmap(map));
hx = hashmap_make_hash(key);
- return erts_hashmap_get_rel(hx, key, map, map_base);
+ return erts_hashmap_get(hx, key, map);
}
BIF_RETTYPE maps_find_2(BIF_ALIST_2) {
@@ -1998,11 +1994,7 @@ Eterm* hashmap_iterator_prev(ErtsWStack* s) {
}
const Eterm *
-#if HALFWORD_HEAP
-erts_hashmap_get_rel(Uint32 hx, Eterm key, Eterm node, Eterm *map_base)
-#else
erts_hashmap_get(Uint32 hx, Eterm key, Eterm node)
-#endif
{
Eterm *ptr, hdr, *res;
Uint ix, lvl = 0;
@@ -2011,7 +2003,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node)
UseTmpHeapNoproc(2);
ASSERT(is_boxed(node));
- ptr = boxed_val_rel(node, map_base);
+ ptr = boxed_val(node);
hdr = *ptr;
ASSERT(is_header(hdr));
ASSERT(is_hashmap_header_head(hdr));
@@ -2032,15 +2024,15 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node)
node = ptr[ix+1];
if (is_list(node)) { /* LEAF NODE [K|V] */
- ptr = list_val_rel(node,map_base);
- res = eq_rel(CAR(ptr), map_base, key, NULL) ? &(CDR(ptr)) : NULL;
+ ptr = list_val(node);
+ res = EQ(CAR(ptr), key) ? &(CDR(ptr)) : NULL;
break;
}
hx = hashmap_shift_hash(th,hx,lvl,key);
ASSERT(is_boxed(node));
- ptr = boxed_val_rel(node, map_base);
+ ptr = boxed_val(node);
hdr = *ptr;
ASSERT(is_header(hdr));
ASSERT(!is_hashmap_header_head(hdr));
@@ -2706,32 +2698,88 @@ BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) {
}
/*
- * erts_internal:map_type/1
+ * erts_internal:term_type/1
*
* Used in erts_debug:size/1
*/
-BIF_RETTYPE erts_internal_map_type_1(BIF_ALIST_1) {
- DECL_AM(hashmap);
- DECL_AM(hashmap_node);
- DECL_AM(flatmap);
- if (is_map(BIF_ARG_1)) {
- Eterm hdr = *(boxed_val(BIF_ARG_1));
- ASSERT(is_header(hdr));
- switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
- case HAMT_SUBTAG_HEAD_FLATMAP:
- BIF_RET(AM_flatmap);
- case HAMT_SUBTAG_HEAD_ARRAY:
- case HAMT_SUBTAG_HEAD_BITMAP:
- BIF_RET(AM_hashmap);
- case HAMT_SUBTAG_NODE_BITMAP:
- BIF_RET(AM_hashmap_node);
- default:
- erl_exit(1, "bad header");
+BIF_RETTYPE erts_internal_term_type_1(BIF_ALIST_1) {
+ Eterm obj = BIF_ARG_1;
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST:
+ BIF_RET(ERTS_MAKE_AM("list"));
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr = *boxed_val(obj);
+ ASSERT(is_header(hdr));
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("tuple"));
+ case EXPORT_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("export"));
+ case FUN_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("fun"));
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD :
+ BIF_RET(ERTS_MAKE_AM("flatmap"));
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ BIF_RET(ERTS_MAKE_AM("hashmap"));
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
+ BIF_RET(ERTS_MAKE_AM("hashmap_node"));
+ default:
+ erl_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:
+ erl_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:
+ erl_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj);
+ }
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj);
+ }
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj);
}
- BIF_P->fvalue = BIF_ARG_1;
- BIF_ERROR(BIF_P, BADMAP);
}
/*
diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h
index 4d9d74bc37..052fa99f03 100644
--- a/erts/emulator/beam/erl_map.h
+++ b/erts/emulator/beam/erl_map.h
@@ -57,7 +57,6 @@ typedef struct flatmap_s {
#define hashmap_size(x) (((hashmap_head_t*) hashmap_val(x))->size)
-#define hashmap_size_rel(RTERM, BASE) hashmap_size(rterm2wterm(RTERM, BASE))
#define hashmap_make_hash(Key) make_internal_hash(Key)
#define hashmap_restore_hash(Heap,Lvl,Key) \
@@ -104,23 +103,9 @@ Eterm erts_hashmap_from_array(ErtsHeapFactory*, Eterm *leafs, Uint n, int rejec
Eterm erts_hashmap_from_ks_and_vs_extra(Process *p, Eterm *ks, Eterm *vs, Uint n,
Eterm k, Eterm v);
-const Eterm *
-#if HALFWORD_HEAP
-erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base);
-# define erts_maps_get(A, B) erts_maps_get_rel(A, B, NULL)
-#else
-erts_maps_get(Eterm key, Eterm map);
-# define erts_maps_get_rel(A, B, B_BASE) erts_maps_get(A, B)
-#endif
+const Eterm *erts_maps_get(Eterm key, Eterm map);
-const Eterm *
-#if HALFWORD_HEAP
-erts_hashmap_get_rel(Uint32 hx, Eterm key, Eterm node, Eterm *map_base);
-# define erts_hashmap_get(Hx, K, M) erts_hashmap_get_rel(Hx, K, M, NULL)
-#else
-erts_hashmap_get(Uint32 hx, Eterm key, Eterm map);
-# define erts_hashmap_get_rel(Hx, K, M, M_BASE) erts_hashmap_get(Hx, K, M)
-#endif
+const Eterm *erts_hashmap_get(Uint32 hx, Eterm key, Eterm map);
/* hamt nodes v2.0
*
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index fa6b2fc613..88efb2c59f 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -33,8 +33,8 @@
#include "erl_binary.h"
#include "dtrace-wrapper.h"
-ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message,
- ErlMessage,
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message_ref,
+ ErtsMessageRef,
ERL_MESSAGE_BUF_SZ,
ERTS_ALC_T_MSG_REF)
@@ -44,27 +44,20 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message,
#undef HARD_DEBUG
#endif
-
-
-
-#ifdef DEBUG
-static ERTS_INLINE int in_heapfrag(const Eterm* ptr, const ErlHeapFragment *bp)
+void
+init_message(void)
{
- return ((unsigned)(ptr - bp->mem) < bp->used_size);
+ init_message_ref_alloc();
}
-#endif
-
-void
-init_message(void)
+void *erts_alloc_message_ref(void)
{
- init_message_alloc();
+ return (void *) message_ref_alloc();
}
-void
-free_message(ErlMessage* mp)
+void erts_free_message_ref(void *mp)
{
- message_free(mp);
+ message_ref_free((ErtsMessageRef *) mp);
}
/* Allocate message buffer (size in words) */
@@ -74,7 +67,8 @@ new_message_buffer(Uint size)
ErlHeapFragment* bp;
bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG,
ERTS_HEAP_FRAG_SIZE(size));
- ERTS_INIT_HEAP_FRAG(bp, size);
+ ERTS_INIT_HEAP_FRAG(bp, size, size);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] new message buffer %p\n", erts_get_current_pid(), bp->mem));
return bp;
}
@@ -203,83 +197,57 @@ free_message_buffer(ErlHeapFragment* bp)
}while (bp != NULL);
}
-static ERTS_INLINE void
-link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp)
+void
+erts_cleanup_messages(ErtsMessage *msgp)
{
- if (bp) {
- /* Link the message buffer */
- bp->next = MBUF(proc);
- MBUF(proc) = bp;
- MBUF_SIZE(proc) += bp->used_size;
- FLAGS(proc) |= F_FORCE_GC;
-
- /* Move any off_heap's into the process */
- if (bp->off_heap.first != NULL) {
- struct erl_off_heap_header** next_p = &bp->off_heap.first;
- while (*next_p != NULL) {
- next_p = &((*next_p)->next);
+ ErtsMessage *mp = msgp;
+ while (mp) {
+ ErtsMessage *fmp;
+ ErlHeapFragment *bp;
+ if (is_non_value(ERL_MESSAGE_TERM(mp))) {
+ if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) {
+ bp = (ErlHeapFragment *) mp->data.dist_ext->ext_endp;
+ erts_cleanup_offheap(&bp->off_heap);
}
- *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;
- ErtsHeapFactory factory;
- Sint sz;
-
- *bpp = NULL;
- sz = erts_decode_dist_ext_size(dist_extp);
- if (sz < 0)
- goto decode_error;
- if (is_not_nil(*tokenp)) {
- ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp);
- tok_sz = heap_frag->used_size;
- sz += tok_sz;
- }
- if (pp) {
- ErlOffHeap *ohp;
- hp = erts_alloc_message_heap(sz, bpp, &ohp, pp, plcksp);
- }
- else {
- *bpp = new_message_buffer(sz);
- hp = (*bpp)->mem;
- }
- erts_factory_message_init(&factory, pp, hp, *bpp);
- msg = erts_decode_dist_ext(&factory, dist_extp);
- if (is_non_value(msg))
- goto decode_error;
- if (is_not_nil(*tokenp)) {
- ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp);
- hp = erts_produce_heap(&factory, tok_sz, 0);
- *tokenp = copy_struct(*tokenp, tok_sz, &hp, factory.off_heap);
- erts_cleanup_offheap(&heap_frag->off_heap);
+ ErtsMessage *nmp = erts_realloc(ERTS_ALC_T_MSG, mp,
+ sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm));
+ if (nmp != mp) {
+ Eterm *sp = &mp->hfrag.mem[0];
+ Eterm *ep = sp + sz;
+ Sint offs = &nmp->hfrag.mem[0] - sp;
+ erts_offset_off_heap(&nmp->hfrag.off_heap, offs, sp, ep);
+ erts_offset_heap(&nmp->hfrag.mem[0], sz, offs, sp, ep);
+ if (brefs && brefs_size)
+ erts_offset_heap_ptr(brefs, brefs_size, offs, sp, ep);
}
- erts_free_dist_ext_copy(dist_extp);
- erts_factory_close(&factory);
- return msg;
- decode_error:
- if (is_not_nil(*tokenp)) {
- ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp);
- erts_cleanup_offheap(&heap_frag->off_heap);
- }
- erts_free_dist_ext_copy(dist_extp);
- *bpp = NULL;
- return THE_NON_VALUE;
- }
+ nmp->hfrag.used_size = sz;
+ nmp->hfrag.alloc_size = sz;
+
+ return nmp;
+}
void
erts_queue_dist_message(Process *rcvr,
@@ -287,7 +255,7 @@ erts_queue_dist_message(Process *rcvr,
ErtsDistExternal *dist_ext,
Eterm token)
{
- ErlMessage* mp;
+ ErtsMessage* mp;
#ifdef USE_VM_PROBES
Sint tok_label = 0;
Sint tok_lastcnt = 0;
@@ -299,7 +267,17 @@ erts_queue_dist_message(Process *rcvr,
ERTS_SMP_LC_ASSERT(*rcvr_locks == erts_proc_lc_my_proc_locks(rcvr));
- mp = message_alloc();
+ mp = erts_alloc_message(0, NULL);
+ mp->data.dist_ext = dist_ext;
+
+ ERL_MESSAGE_TERM(mp) = THE_NON_VALUE;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(mp) = NIL;
+ if (token == am_have_dt_utag)
+ ERL_MESSAGE_TOKEN(mp) = NIL;
+ else
+#endif
+ ERL_MESSAGE_TOKEN(mp) = token;
#ifdef ERTS_SMP
if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) {
@@ -318,64 +296,46 @@ erts_queue_dist_message(Process *rcvr,
if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ))
erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
/* Drop message if receiver is exiting or has a pending exit ... */
- if (is_not_nil(token)) {
- ErlHeapFragment *heap_frag;
- heap_frag = erts_dist_ext_trailer(mp->data.dist_ext);
- erts_cleanup_offheap(&heap_frag->off_heap);
- }
- erts_free_dist_ext_copy(dist_ext);
- message_free(mp);
+ erts_cleanup_messages(mp);
}
else
#endif
if (IS_TRACED_FL(rcvr, F_TRACE_RECEIVE)) {
/* Ahh... need to decode it in order to trace it... */
- ErlHeapFragment *mbuf;
- Eterm msg;
if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ))
erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
- message_free(mp);
- msg = erts_msg_distext2heap(rcvr, rcvr_locks, &mbuf, &token, dist_ext);
- if (is_value(msg))
+ if (!erts_decode_dist_message(rcvr, *rcvr_locks, mp, 0))
+ erts_free_message(mp);
+ else {
+ Eterm msg = ERL_MESSAGE_TERM(mp);
+ token = ERL_MESSAGE_TOKEN(mp);
#ifdef USE_VM_PROBES
- if (DTRACE_ENABLED(message_queued)) {
- DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
-
- dtrace_proc_str(rcvr, receiver_name);
- if (token != NIL && token != am_have_dt_utag) {
- tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
- tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
- tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
- }
- DTRACE6(message_queued,
- receiver_name, size_object(msg), rcvr->msg.len,
- tok_label, tok_lastcnt, tok_serial);
- }
+ if (DTRACE_ENABLED(message_queued)) {
+ DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
+
+ dtrace_proc_str(rcvr, receiver_name);
+ if (have_seqtrace(token)) {
+ tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
+ tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
+ tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
+ }
+ DTRACE6(message_queued,
+ receiver_name, size_object(msg), rcvr->msg.len,
+ tok_label, tok_lastcnt, tok_serial);
+ }
#endif
- erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token);
+ erts_queue_message(rcvr, rcvr_locks, mp, msg, token);
+ }
}
else {
/* Enqueue message on external format */
- ERL_MESSAGE_TERM(mp) = THE_NON_VALUE;
-#ifdef USE_VM_PROBES
- ERL_MESSAGE_DT_UTAG(mp) = NIL;
- if (token == am_have_dt_utag) {
- ERL_MESSAGE_TOKEN(mp) = NIL;
- } else {
-#endif
- ERL_MESSAGE_TOKEN(mp) = token;
-#ifdef USE_VM_PROBES
- }
-#endif
- mp->next = NULL;
-
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(message_queued)) {
DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
dtrace_proc_str(rcvr, receiver_name);
- if (token != NIL && token != am_have_dt_utag) {
+ if (have_seqtrace(token)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
@@ -388,7 +348,7 @@ erts_queue_dist_message(Process *rcvr,
tok_label, tok_lastcnt, tok_serial);
}
#endif
- mp->data.dist_ext = dist_ext;
+
LINK_MESSAGE(rcvr, mp);
if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ))
@@ -408,9 +368,9 @@ erts_queue_dist_message(Process *rcvr,
static Sint
queue_message(Process *c_p,
Process* receiver,
- ErtsProcLocks *receiver_locks,
erts_aint32_t *receiver_state,
- ErlHeapFragment* bp,
+ ErtsProcLocks *receiver_locks,
+ ErtsMessage* mp,
Eterm message,
Eterm seq_trace_token
#ifdef USE_VM_PROBES
@@ -419,31 +379,24 @@ queue_message(Process *c_p,
)
{
Sint res;
- ErlMessage* mp;
int locked_msgq = 0;
- erts_aint_t state;
-
-#ifndef ERTS_SMP
- ASSERT(bp != NULL || receiver->mbuf == NULL);
-#endif
+ erts_aint32_t state;
ERTS_SMP_LC_ASSERT(*receiver_locks == erts_proc_lc_my_proc_locks(receiver));
- mp = message_alloc();
-
- if (receiver_state)
- state = *receiver_state;
- else
- state = erts_smp_atomic32_read_acqb(&receiver->state);
-
#ifdef ERTS_SMP
- if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT))
- goto exiting;
-
if (!(*receiver_locks & ERTS_PROC_LOCK_MSGQ)) {
if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MSGQ) == EBUSY) {
ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ;
+
+ if (receiver_state)
+ state = *receiver_state;
+ else
+ state = erts_smp_atomic32_read_nob(&receiver->state);
+ if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT))
+ goto exiting;
+
if (*receiver_locks & ERTS_PROC_LOCK_STATUS) {
erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS);
need_locks |= ERTS_PROC_LOCK_STATUS;
@@ -451,13 +404,12 @@ queue_message(Process *c_p,
erts_smp_proc_lock(receiver, need_locks);
}
locked_msgq = 1;
- state = erts_smp_atomic32_read_nob(&receiver->state);
- if (receiver_state)
- *receiver_state = state;
}
#endif
+ state = erts_smp_atomic32_read_nob(&receiver->state);
+
if (state & (ERTS_PSFLG_PENDING_EXIT|ERTS_PSFLG_EXITING)) {
#ifdef ERTS_SMP
exiting:
@@ -465,9 +417,7 @@ queue_message(Process *c_p,
/* Drop message if receiver is exiting or has a pending exit... */
if (locked_msgq)
erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ);
- if (bp)
- free_message_buffer(bp);
- message_free(mp);
+ erts_cleanup_messages(mp);
return 0;
}
@@ -476,13 +426,9 @@ queue_message(Process *c_p,
#ifdef USE_VM_PROBES
ERL_MESSAGE_DT_UTAG(mp) = dt_utag;
#endif
- mp->next = NULL;
- mp->data.heap_frag = bp;
-#ifndef ERTS_SMP
res = receiver->msg.len;
-#else
- res = receiver->msg_inq.len;
+#ifdef ERTS_SMP
if (*receiver_locks & ERTS_PROC_LOCK_MAIN) {
/*
* We move 'in queue' to 'private queue' and place
@@ -492,7 +438,7 @@ queue_message(Process *c_p,
* we don't need to include the 'in queue' in
* the root set when garbage collecting.
*/
- res += receiver->msg.len;
+ res += receiver->msg_inq.len;
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver);
LINK_MESSAGE_PRIVQ(receiver, mp);
}
@@ -544,19 +490,19 @@ queue_message(Process *c_p,
void
#ifdef USE_VM_PROBES
erts_queue_message_probe(Process* receiver, ErtsProcLocks *receiver_locks,
- ErlHeapFragment* bp,
+ ErtsMessage* mp,
Eterm message, Eterm seq_trace_token, Eterm dt_utag)
#else
erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks,
- ErlHeapFragment* bp,
+ ErtsMessage* mp,
Eterm message, Eterm seq_trace_token)
#endif
{
queue_message(NULL,
receiver,
- receiver_locks,
NULL,
- bp,
+ receiver_locks,
+ mp,
message,
seq_trace_token
#ifdef USE_VM_PROBES
@@ -566,245 +512,37 @@ erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks,
}
void
-erts_link_mbuf_to_proc(struct process *proc, ErlHeapFragment *bp)
+erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *first_bp)
{
- Eterm* htop = HEAP_TOP(proc);
-
- link_mbuf_to_proc(proc, bp);
- if (htop < HEAP_LIMIT(proc)) {
- *htop = make_pos_bignum_header(HEAP_LIMIT(proc)-htop-1);
- HEAP_TOP(proc) = HEAP_LIMIT(proc);
- }
-}
-
-/*
- * Moves content of message buffer attached to a message into a heap.
- * The message buffer is deallocated.
- */
-void
-erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
-{
- struct erl_off_heap_header* oh;
- Eterm term, token, *fhp, *hp;
- Sint offs;
- Uint sz;
- ErlHeapFragment *bp;
-#ifdef USE_VM_PROBES
- Eterm utag;
-#endif
-
-#ifdef HARD_DEBUG
- struct erl_off_heap_header* dbg_oh_start = off_heap->first;
- Eterm dbg_term, dbg_token;
- ErlHeapFragment *dbg_bp;
- Uint *dbg_hp, *dbg_thp_start;
- Uint dbg_term_sz, dbg_token_sz;
-#ifdef USE_VM_PROBES
- Eterm dbg_utag;
- Uint dbg_utag_sz;
-#endif
-#endif
-
- bp = msg->data.heap_frag;
- term = ERL_MESSAGE_TERM(msg);
- token = ERL_MESSAGE_TOKEN(msg);
-#ifdef USE_VM_PROBES
- utag = ERL_MESSAGE_DT_UTAG(msg);
-#endif
- if (!bp) {
-#ifdef USE_VM_PROBES
- ASSERT(is_immed(term) && is_immed(token) && is_immed(utag));
-#else
- ASSERT(is_immed(term) && is_immed(token));
-#endif
- return;
- }
-
-#ifdef HARD_DEBUG
- dbg_term_sz = size_object(term);
- dbg_token_sz = size_object(token);
- dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz);
-#ifdef USE_VM_PROBES
- dbg_utag_sz = size_object(utag);
- dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz + dbg_utag_sz );
-#endif
- /*ASSERT(dbg_term_sz + dbg_token_sz == erts_msg_used_frag_sz(msg));
- Copied size may be smaller due to removed SubBins's or garbage.
- Copied size may be larger due to duplicated shared terms.
- */
- dbg_hp = dbg_bp->mem;
- dbg_term = copy_struct(term, dbg_term_sz, &dbg_hp, &dbg_bp->off_heap);
- dbg_token = copy_struct(token, dbg_token_sz, &dbg_hp, &dbg_bp->off_heap);
-#ifdef USE_VM_PROBES
- dbg_utag = copy_struct(utag, dbg_utag_sz, &dbg_hp, &dbg_bp->off_heap);
-#endif
- dbg_thp_start = *hpp;
-#endif
-
- if (bp->next != NULL) {
- move_multi_frags(hpp, off_heap, bp, msg->m,
-#ifdef USE_VM_PROBES
- 3
-#else
- 2
-#endif
- );
- goto copy_done;
- }
-
- OH_OVERHEAD(off_heap, bp->off_heap.overhead);
- sz = bp->used_size;
-
- ASSERT(is_immed(term) || in_heapfrag(ptr_val(term),bp));
- ASSERT(is_immed(token) || in_heapfrag(ptr_val(token),bp));
-
- fhp = bp->mem;
- hp = *hpp;
- offs = hp - fhp;
-
- oh = NULL;
- while (sz--) {
- Uint cpy_sz;
- Eterm val = *fhp++;
-
- switch (primary_tag(val)) {
- case TAG_PRIMARY_IMMED1:
- *hp++ = val;
- break;
- case TAG_PRIMARY_LIST:
- case TAG_PRIMARY_BOXED:
- ASSERT(in_heapfrag(ptr_val(val), bp));
- *hp++ = offset_ptr(val, offs);
- break;
- case TAG_PRIMARY_HEADER:
- *hp++ = val;
- switch (val & _HEADER_SUBTAG_MASK) {
- case ARITYVAL_SUBTAG:
- break;
- case REFC_BINARY_SUBTAG:
- case FUN_SUBTAG:
- case EXTERNAL_PID_SUBTAG:
- case EXTERNAL_PORT_SUBTAG:
- case EXTERNAL_REF_SUBTAG:
- oh = (struct erl_off_heap_header*) (hp-1);
- cpy_sz = thing_arityval(val);
- goto cpy_words;
- default:
- cpy_sz = header_arity(val);
-
- cpy_words:
- ASSERT(sz >= cpy_sz);
- sz -= cpy_sz;
- while (cpy_sz >= 8) {
- cpy_sz -= 8;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- }
- switch (cpy_sz) {
- case 7: *hp++ = *fhp++;
- case 6: *hp++ = *fhp++;
- case 5: *hp++ = *fhp++;
- case 4: *hp++ = *fhp++;
- case 3: *hp++ = *fhp++;
- case 2: *hp++ = *fhp++;
- case 1: *hp++ = *fhp++;
- default: break;
+ if (first_bp) {
+ ErlHeapFragment *bp = first_bp;
+
+ while (1) {
+ /* Move any off_heap's into the process */
+ if (bp->off_heap.first != NULL) {
+ struct erl_off_heap_header** next_p = &bp->off_heap.first;
+ while (*next_p != NULL) {
+ next_p = &((*next_p)->next);
}
- if (oh) {
- /* Add to offheap list */
- oh->next = off_heap->first;
- off_heap->first = oh;
- ASSERT(*hpp <= (Eterm*)oh);
- ASSERT(hp > (Eterm*)oh);
- oh = NULL;
- }
- break;
+ *next_p = MSO(proc).first;
+ MSO(proc).first = bp->off_heap.first;
+ bp->off_heap.first = NULL;
+ OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead);
}
- break;
+ MBUF_SIZE(proc) += bp->used_size;
+ if (!bp->next)
+ break;
+ bp = bp->next;
}
- }
-
- ASSERT(bp->used_size == hp - *hpp);
- *hpp = hp;
- if (is_not_immed(token)) {
- ASSERT(in_heapfrag(ptr_val(token), bp));
- ERL_MESSAGE_TOKEN(msg) = offset_ptr(token, offs);
-#ifdef HARD_DEBUG
- ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TOKEN(msg)));
- ASSERT(hp > ptr_val(ERL_MESSAGE_TOKEN(msg)));
-#endif
- }
-
- if (is_not_immed(term)) {
- ASSERT(in_heapfrag(ptr_val(term),bp));
- ERL_MESSAGE_TERM(msg) = offset_ptr(term, offs);
-#ifdef HARD_DEBUG
- ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TERM(msg)));
- ASSERT(hp > ptr_val(ERL_MESSAGE_TERM(msg)));
-#endif
- }
-#ifdef USE_VM_PROBES
- if (is_not_immed(utag)) {
- ASSERT(in_heapfrag(ptr_val(utag), bp));
- ERL_MESSAGE_DT_UTAG(msg) = offset_ptr(utag, offs);
-#ifdef HARD_DEBUG
- ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_DT_UTAG(msg)));
- ASSERT(hp > ptr_val(ERL_MESSAGE_DT_UTAG(msg)));
-#endif
- }
-#endif
-
-copy_done:
-
-#ifdef HARD_DEBUG
- {
- int i, j;
- ErlHeapFragment* frag;
- {
- struct erl_off_heap_header* dbg_oh = off_heap->first;
- i = j = 0;
- while (dbg_oh != dbg_oh_start) {
- dbg_oh = dbg_oh->next;
- i++;
- }
- for (frag=bp; frag; frag=frag->next) {
- dbg_oh = frag->off_heap.first;
- while (dbg_oh) {
- dbg_oh = dbg_oh->next;
- j++;
- }
- }
- ASSERT(i == j);
- }
+ /* Link the message buffer */
+ bp->next = MBUF(proc);
+ MBUF(proc) = first_bp;
}
-#endif
-
-
- bp->off_heap.first = NULL;
- free_message_buffer(bp);
- msg->data.heap_frag = NULL;
-
-#ifdef HARD_DEBUG
- ASSERT(eq(ERL_MESSAGE_TERM(msg), dbg_term));
- ASSERT(eq(ERL_MESSAGE_TOKEN(msg), dbg_token));
-#ifdef USE_VM_PROBES
- ASSERT(eq(ERL_MESSAGE_DT_UTAG(msg), dbg_utag));
-#endif
- free_message_buffer(dbg_bp);
-#endif
-
}
-
Uint
-erts_msg_attached_data_size_aux(ErlMessage *msg)
+erts_msg_attached_data_size_aux(ErtsMessage *msg)
{
Sint sz;
ASSERT(is_non_value(ERL_MESSAGE_TERM(msg)));
@@ -833,29 +571,87 @@ erts_msg_attached_data_size_aux(ErlMessage *msg)
return sz;
}
-void
-erts_move_msg_attached_data_to_heap(ErtsHeapFactory* factory,
- ErlMessage *msg)
+ErtsMessage *
+erts_try_alloc_message_on_heap(Process *pp,
+ erts_aint32_t *psp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp,
+ int *on_heap_p)
{
- if (is_value(ERL_MESSAGE_TERM(msg)))
- erts_move_msg_mbuf_to_heap(&factory->hp, factory->off_heap, msg);
- else if (msg->data.dist_ext) {
- ASSERT(msg->data.dist_ext->heap_size >= 0);
- if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) {
- ErlHeapFragment *heap_frag;
- heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
- ERL_MESSAGE_TOKEN(msg) = copy_struct(ERL_MESSAGE_TOKEN(msg),
- heap_frag->used_size,
- &factory->hp,
- factory->off_heap);
- erts_cleanup_offheap(&heap_frag->off_heap);
+#ifdef ERTS_SMP
+ int locked_main = 0;
+#endif
+ ErtsMessage *mp;
+
+ ASSERT(!(*psp & ERTS_PSFLG_OFF_HEAP_MSGQ));
+
+ if (
+#if defined(ERTS_SMP)
+ *plp & ERTS_PROC_LOCK_MAIN
+#else
+ 1
+#endif
+ ) {
+#ifdef ERTS_SMP
+ try_on_heap:
+#endif
+ if ((*psp & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT))
+ || (pp->flags & F_DISABLE_GC)
+ || HEAP_LIMIT(pp) - HEAP_TOP(pp) <= sz) {
+ /*
+ * The heap is either potentially in an inconsistent
+ * state, or not large enough.
+ */
+#ifdef ERTS_SMP
+ if (locked_main) {
+ *plp &= ~ERTS_PROC_LOCK_MAIN;
+ erts_smp_proc_unlock(pp, ERTS_PROC_LOCK_MAIN);
+ }
+#endif
+ goto in_message_fragment;
}
- ERL_MESSAGE_TERM(msg) = erts_decode_dist_ext(factory,
- msg->data.dist_ext);
- erts_free_dist_ext_copy(msg->data.dist_ext);
- msg->data.dist_ext = NULL;
+
+ *hpp = HEAP_TOP(pp);
+ HEAP_TOP(pp) = *hpp + sz;
+ *ohpp = &MSO(pp);
+ mp = erts_alloc_message(0, NULL);
+ mp->data.attached = NULL;
+ *on_heap_p = !0;
+ }
+#ifdef ERTS_SMP
+ else if (erts_smp_proc_trylock(pp, ERTS_PROC_LOCK_MAIN) == 0) {
+ locked_main = 1;
+ *psp = erts_smp_atomic32_read_nob(&pp->state);
+ *plp |= ERTS_PROC_LOCK_MAIN;
+ goto try_on_heap;
}
- /* else: bad external detected when calculating size */
+#endif
+ else {
+ in_message_fragment:
+ if (!((*psp) & ERTS_PSFLG_ON_HEAP_MSGQ)) {
+ mp = erts_alloc_message(sz, hpp);
+ *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap;
+ }
+ else {
+ mp = erts_alloc_message(0, NULL);
+ if (!sz) {
+ *hpp = NULL;
+ *ohpp = NULL;
+ }
+ else {
+ ErlHeapFragment *bp;
+ bp = new_message_buffer(sz);
+ *hpp = &bp->mem[0];
+ mp->data.heap_frag = bp;
+ *ohpp = &bp->off_heap;
+ }
+ }
+ *on_heap_p = 0;
+ }
+
+ return mp;
}
/*
@@ -870,7 +666,8 @@ erts_send_message(Process* sender,
unsigned flags)
{
Uint msize;
- ErlHeapFragment* bp = NULL;
+ ErtsMessage* mp;
+ ErlOffHeap *ohp;
Eterm token = NIL;
Sint res = 0;
#ifdef USE_VM_PROBES
@@ -879,67 +676,96 @@ erts_send_message(Process* sender,
Sint tok_label = 0;
Sint tok_lastcnt = 0;
Sint tok_serial = 0;
+ Eterm utag = NIL;
+#endif
+ erts_aint32_t receiver_state;
+#ifdef SHCOPY_SEND
+ erts_shcopy_t info;
#endif
BM_STOP_TIMER(system);
BM_MESSAGE(message,sender,receiver);
BM_START_TIMER(send);
- #ifdef USE_VM_PROBES
+#ifdef USE_VM_PROBES
*sender_name = *receiver_name = '\0';
- if (DTRACE_ENABLED(message_send)) {
+ if (DTRACE_ENABLED(message_send)) {
erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)),
"%T", sender->common.id);
erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)),
"%T", receiver->common.id);
}
#endif
+
+ receiver_state = erts_smp_atomic32_read_nob(&receiver->state);
+
if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) {
Eterm* hp;
Eterm stoken = SEQ_TRACE_TOKEN(sender);
Uint seq_trace_size = 0;
#ifdef USE_VM_PROBES
Uint dt_utag_size = 0;
- Eterm utag = NIL;
#endif
-
- BM_SWAP_TIMER(send,size);
- msize = size_object(message);
- BM_SWAP_TIMER(size,send);
-
-#ifdef USE_VM_PROBES
- if (stoken != am_have_dt_utag) {
-#endif
-
+ BM_SWAP_TIMER(send,size);
+
+ /* SHCOPY corrupts the heap between
+ * copy_shared_calculate, and
+ * copy_shared_perform. (it inserts move_markers like the gc).
+ * Make sure we don't use the heap between those instances.
+ */
+ if (have_seqtrace(stoken)) {
seq_trace_update_send(sender);
seq_trace_output(stoken, message, SEQ_TRACE_SEND,
receiver->common.id, sender);
seq_trace_size = 6; /* TUPLE5 */
-#ifdef USE_VM_PROBES
- }
- if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) {
- dt_utag_size = size_object(DT_UTAG(sender));
- } else if (stoken == am_have_dt_utag ) {
- stoken = NIL;
}
+#ifdef USE_VM_PROBES
+ if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) {
+ dt_utag_size = size_object(DT_UTAG(sender));
+ } else if (stoken == am_have_dt_utag ) {
+ stoken = NIL;
+ }
+#endif
+
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ msize = copy_shared_calculate(message, &info);
+#else
+ msize = size_object(message);
#endif
+ BM_SWAP_TIMER(size,send);
- bp = new_message_buffer(msize + seq_trace_size
+ mp = erts_alloc_message_heap_state(receiver,
+ &receiver_state,
+ receiver_locks,
+ (msize
#ifdef USE_VM_PROBES
- + dt_utag_size
+ + dt_utag_size
#endif
- );
- hp = bp->mem;
+ + seq_trace_size),
+ &hp,
+ &ohp);
BM_SWAP_TIMER(send,copy);
- token = copy_struct(stoken,
- seq_trace_size,
- &hp,
- &bp->off_heap);
- message = copy_struct(message, msize, &hp, &bp->off_heap);
+#ifdef SHCOPY_SEND
+ if (is_not_immed(message))
+ message = copy_shared_perform(message, msize, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ if (is_not_immed(message))
+ message = copy_struct(message, msize, &hp, ohp);
+#endif
+ if (is_immed(stoken))
+ token = stoken;
+ else
+ token = copy_struct(stoken, seq_trace_size, &hp, ohp);
+
#ifdef USE_VM_PROBES
if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) {
- utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, &bp->off_heap);
+ if (is_immed(DT_UTAG(sender)))
+ utag = DT_UTAG(sender);
+ else
+ utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, ohp);
#ifdef DTRACE_TAG_HARDDEBUG
erts_fprintf(stderr,
"Dtrace -> (%T) Spreading tag (%T) with "
@@ -952,7 +778,7 @@ erts_send_message(Process* sender,
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(message_send)) {
- if (stoken != NIL && stoken != am_have_dt_utag) {
+ if (have_seqtrace(stoken)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(stoken));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(stoken));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(stoken));
@@ -961,103 +787,63 @@ erts_send_message(Process* sender,
msize, tok_label, tok_lastcnt, tok_serial);
}
#endif
- res = queue_message(NULL,
- receiver,
- receiver_locks,
- NULL,
- bp,
- message,
- token
-#ifdef USE_VM_PROBES
- , utag
-#endif
- );
- BM_SWAP_TIMER(send,system);
- } else if (sender == receiver) {
- /* Drop message if receiver has a pending exit ... */
-#ifdef ERTS_SMP
- ErtsProcLocks need_locks = (~(*receiver_locks)
- & (ERTS_PROC_LOCK_MSGQ
- | ERTS_PROC_LOCK_STATUS));
- if (need_locks) {
- *receiver_locks |= need_locks;
- if (erts_smp_proc_trylock(receiver, need_locks) == EBUSY) {
- if (need_locks == ERTS_PROC_LOCK_MSGQ) {
- erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS);
- need_locks = ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS;
- }
- erts_smp_proc_lock(receiver, need_locks);
- }
+ } else {
+ Eterm *hp;
+
+ if (receiver == sender && !(receiver_state & ERTS_PSFLG_OFF_HEAP_MSGQ)) {
+ mp = erts_alloc_message(0, NULL);
+ msize = 0;
}
- if (!ERTS_PROC_PENDING_EXIT(receiver))
+ else {
+ BM_SWAP_TIMER(send,size);
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ msize = copy_shared_calculate(message, &info);
+#else
+ msize = size_object(message);
#endif
- {
- ErlMessage* mp = message_alloc();
-
- DTRACE6(message_send, sender_name, receiver_name,
- size_object(message), tok_label, tok_lastcnt, tok_serial);
- mp->data.attached = NULL;
- ERL_MESSAGE_TERM(mp) = message;
- ERL_MESSAGE_TOKEN(mp) = NIL;
-#ifdef USE_VM_PROBES
- ERL_MESSAGE_DT_UTAG(mp) = NIL;
+ BM_SWAP_TIMER(size,send);
+
+ mp = erts_alloc_message_heap_state(receiver,
+ &receiver_state,
+ receiver_locks,
+ msize,
+ &hp,
+ &ohp);
+ BM_SWAP_TIMER(send,copy);
+#ifdef SHCOPY_SEND
+ if (is_not_immed(message))
+ message = copy_shared_perform(message, msize, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ if (is_not_immed(message))
+ message = copy_struct(message, msize, &hp, ohp);
#endif
- mp->next = NULL;
- /*
- * We move 'in queue' to 'private queue' and place
- * message at the end of 'private queue' in order
- * to ensure that the 'in queue' doesn't contain
- * references into the heap. By ensuring this,
- * we don't need to include the 'in queue' in
- * the root set when garbage collecting.
- */
-
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver);
- LINK_MESSAGE_PRIVQ(receiver, mp);
-
- res = receiver->msg.len;
-
- if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) {
- trace_receive(receiver, message);
- }
+ BM_MESSAGE_COPIED(msz);
+ BM_SWAP_TIMER(copy,send);
}
- BM_SWAP_TIMER(send,system);
- } else {
- ErlOffHeap *ohp;
- Eterm *hp;
- erts_aint32_t state;
-
- BM_SWAP_TIMER(send,size);
- msize = size_object(message);
- BM_SWAP_TIMER(size,send);
- hp = erts_alloc_message_heap_state(msize,
- &bp,
- &ohp,
- receiver,
- receiver_locks,
- &state);
- BM_SWAP_TIMER(send,copy);
- message = copy_struct(message, msize, &hp, ohp);
- BM_MESSAGE_COPIED(msz);
- BM_SWAP_TIMER(copy,send);
DTRACE6(message_send, sender_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
- res = queue_message(sender,
- receiver,
- receiver_locks,
- &state,
- bp,
- message,
- token
+ }
+
+ res = queue_message(sender,
+ receiver,
+ &receiver_state,
+ receiver_locks,
+ mp,
+ message,
+ token
#ifdef USE_VM_PROBES
- , NIL
+ , utag
#endif
- );
- BM_SWAP_TIMER(send,system);
- }
- return res;
+ );
+
+ BM_SWAP_TIMER(send,system);
+
+ return res;
}
+
/*
* This function delivers an EXIT message to a process
* which is trapping EXITs.
@@ -1075,46 +861,572 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp,
Uint sz_from;
Eterm* hp;
Eterm temptoken;
- ErlHeapFragment* bp = NULL;
-
- if (token != NIL
-#ifdef USE_VM_PROBES
- && token != am_have_dt_utag
+ ErtsMessage* mp;
+ ErlOffHeap *ohp;
+#ifdef SHCOPY_SEND
+ erts_shcopy_t info;
#endif
- ) {
+ if (have_seqtrace(token)) {
ASSERT(is_tuple(token));
- sz_reason = size_object(reason);
sz_token = size_object(token);
sz_from = size_object(from);
- bp = new_message_buffer(sz_reason + sz_from + sz_token + 4);
- hp = bp->mem;
- mess = copy_struct(reason, sz_reason, &hp, &bp->off_heap);
- from_copy = copy_struct(from, sz_from, &hp, &bp->off_heap);
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ sz_reason = copy_shared_calculate(reason, &info);
+#else
+ sz_reason = size_object(reason);
+#endif
+ mp = erts_alloc_message_heap(to, to_locksp,
+ sz_reason + sz_from + sz_token + 4,
+ &hp, &ohp);
+#ifdef SHCOPY_SEND
+ mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ mess = copy_struct(reason, sz_reason, &hp, ohp);
+#endif
+ from_copy = copy_struct(from, sz_from, &hp, ohp);
save = TUPLE3(hp, am_EXIT, from_copy, mess);
hp += 4;
/* the trace token must in this case be updated by the caller */
seq_trace_output(token, save, SEQ_TRACE_SEND, to->common.id, NULL);
- temptoken = copy_struct(token, sz_token, &hp, &bp->off_heap);
- erts_queue_message(to, to_locksp, bp, save, temptoken);
+ temptoken = copy_struct(token, sz_token, &hp, ohp);
+ erts_queue_message(to, to_locksp, mp, save, temptoken);
} else {
- ErlOffHeap *ohp;
- sz_reason = size_object(reason);
sz_from = IS_CONST(from) ? 0 : size_object(from);
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ sz_reason = copy_shared_calculate(reason, &info);
+#else
+ sz_reason = size_object(reason);
+#endif
+ mp = erts_alloc_message_heap(to, to_locksp,
+ sz_reason+sz_from+4, &hp, &ohp);
- hp = erts_alloc_message_heap(sz_reason+sz_from+4,
- &bp,
- &ohp,
- to,
- to_locksp);
-
+#ifdef SHCOPY_SEND
+ mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
mess = copy_struct(reason, sz_reason, &hp, ohp);
+#endif
from_copy = (IS_CONST(from)
? from
: copy_struct(from, sz_from, &hp, ohp));
save = TUPLE3(hp, am_EXIT, from_copy, mess);
- erts_queue_message(to, to_locksp, bp, save, NIL);
+ erts_queue_message(to, to_locksp, mp, save, NIL);
+ }
+}
+
+void erts_save_message_in_proc(Process *p, ErtsMessage *msgp)
+{
+ ErlHeapFragment *hfp;
+
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ hfp = &msgp->hfrag;
+ else if (msgp->data.attached) {
+ hfp = msgp->data.heap_frag;
+ }
+ else {
+ erts_free_message(msgp);
+ return; /* Nothing to save */
+ }
+
+ while (1) {
+ struct erl_off_heap_header *ohhp = hfp->off_heap.first;
+ if (ohhp) {
+ for ( ; ohhp->next; ohhp = ohhp->next)
+ ;
+ ohhp->next = p->off_heap.first;
+ p->off_heap.first = hfp->off_heap.first;
+ hfp->off_heap.first = NULL;
+ }
+ p->off_heap.overhead += hfp->off_heap.overhead;
+ hfp->off_heap.overhead = 0;
+ p->mbuf_sz += hfp->used_size;
+
+ if (!hfp->next)
+ break;
+ hfp = hfp->next;
+ }
+
+ msgp->next = p->msg_frag;
+ p->msg_frag = msgp;
+}
+
+Sint
+erts_move_messages_off_heap(Process *c_p)
+{
+ int reds = 1;
+ /*
+ * Move all messages off heap. This *only* occurs when the
+ * process had off heap message disabled and just enabled
+ * it...
+ */
+ ErtsMessage *mp;
+
+ reds += c_p->msg.len / 10;
+
+ ASSERT(erts_smp_atomic32_read_nob(&c_p->state)
+ & ERTS_PSFLG_OFF_HEAP_MSGQ);
+ ASSERT(c_p->flags & F_OFF_HEAP_MSGQ_CHNG);
+
+ for (mp = c_p->msg.first; mp; mp = mp->next) {
+ Uint msg_sz, token_sz;
+#ifdef USE_VM_PROBES
+ Uint utag_sz;
+#endif
+ Eterm *hp;
+ ErlHeapFragment *hfrag;
+
+ if (mp->data.attached)
+ continue;
+
+ if (is_immed(ERL_MESSAGE_TERM(mp))
+#ifdef USE_VM_PROBES
+ && is_immed(ERL_MESSAGE_DT_UTAG(mp))
+#endif
+ && is_not_immed(ERL_MESSAGE_TOKEN(mp)))
+ continue;
+
+ /*
+ * The message refers into the heap. Copy the message
+ * from the heap into a heap fragment and attach
+ * it to the message...
+ */
+ msg_sz = size_object(ERL_MESSAGE_TERM(mp));
+#ifdef USE_VM_PROBES
+ utag_sz = size_object(ERL_MESSAGE_DT_UTAG(mp));
+#endif
+ token_sz = size_object(ERL_MESSAGE_TOKEN(mp));
+
+ hfrag = new_message_buffer(msg_sz
+#ifdef USE_VM_PROBES
+ + utag_sz
+#endif
+ + token_sz);
+ hp = hfrag->mem;
+ if (is_not_immed(ERL_MESSAGE_TERM(mp)))
+ ERL_MESSAGE_TERM(mp) = copy_struct(ERL_MESSAGE_TERM(mp),
+ msg_sz, &hp,
+ &hfrag->off_heap);
+ if (is_not_immed(ERL_MESSAGE_TOKEN(mp)))
+ ERL_MESSAGE_TOKEN(mp) = copy_struct(ERL_MESSAGE_TOKEN(mp),
+ token_sz, &hp,
+ &hfrag->off_heap);
+#ifdef USE_VM_PROBES
+ if (is_not_immed(ERL_MESSAGE_DT_UTAG(mp)))
+ ERL_MESSAGE_DT_UTAG(mp) = copy_struct(ERL_MESSAGE_DT_UTAG(mp),
+ utag_sz, &hp,
+ &hfrag->off_heap);
+#endif
+ mp->data.heap_frag = hfrag;
+ reds += 1;
+ }
+
+ return reds;
+}
+
+Sint
+erts_complete_off_heap_message_queue_change(Process *c_p)
+{
+ int reds = 1;
+
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
+ ASSERT(c_p->flags & F_OFF_HEAP_MSGQ_CHNG);
+ ASSERT(erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_OFF_HEAP_MSGQ);
+
+ /*
+ * This job was first initiated when the process changed to off heap
+ * message queue management. Since then ERTS_PSFLG_OFF_HEAP_MSGQ
+ * has been set. However, the management state might have been changed
+ * again (multiple times) since then. Check users last requested state
+ * (the flags F_OFF_HEAP_MSGQ, and F_ON_HEAP_MSGQ), and make the state
+ * consistent with that.
+ */
+
+ if (!(c_p->flags & F_OFF_HEAP_MSGQ))
+ erts_smp_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_OFF_HEAP_MSGQ);
+ else {
+ reds += 2;
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+ reds += erts_move_messages_off_heap(c_p);
}
+ c_p->flags &= ~F_OFF_HEAP_MSGQ_CHNG;
+ return reds;
+}
+
+typedef struct {
+ Eterm pid;
+ ErtsThrPrgrLaterOp lop;
+} ErtsChangeOffHeapMessageQueue;
+
+static void
+change_off_heap_msgq(void *vcohmq)
+{
+ ErtsChangeOffHeapMessageQueue *cohmq;
+ /*
+ * Now we've waited thread progress which ensures that all
+ * messages to the process are enqueued off heap. Schedule
+ * completion of this change as a system task on the process
+ * itself. This in order to avoid lock contention on its
+ * main lock. We will be called in
+ * erts_complete_off_heap_message_queue_change() (above) when
+ * the system task has been selected for execution.
+ */
+ cohmq = (ErtsChangeOffHeapMessageQueue *) vcohmq;
+ erts_schedule_complete_off_heap_message_queue_change(cohmq->pid);
+ erts_free(ERTS_ALC_T_MSGQ_CHNG, vcohmq);
+}
+
+Eterm
+erts_change_message_queue_management(Process *c_p, Eterm new_state)
+{
+ Eterm res;
+
+#ifdef DEBUG
+ if (c_p->flags & F_OFF_HEAP_MSGQ) {
+ ASSERT(erts_smp_atomic32_read_nob(&c_p->state)
+ & ERTS_PSFLG_OFF_HEAP_MSGQ);
+ }
+ else {
+ if (c_p->flags & F_OFF_HEAP_MSGQ_CHNG) {
+ ASSERT(erts_smp_atomic32_read_nob(&c_p->state)
+ & ERTS_PSFLG_OFF_HEAP_MSGQ);
+ }
+ else {
+ ASSERT(!(erts_smp_atomic32_read_nob(&c_p->state)
+ & ERTS_PSFLG_OFF_HEAP_MSGQ));
+ }
+ }
+#endif
+
+ switch (c_p->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) {
+
+ case F_OFF_HEAP_MSGQ:
+ res = am_off_heap;
+
+ switch (new_state) {
+ case am_off_heap:
+ break;
+ case am_on_heap:
+ c_p->flags |= F_ON_HEAP_MSGQ;
+ erts_smp_atomic32_read_bor_nob(&c_p->state,
+ ERTS_PSFLG_ON_HEAP_MSGQ);
+ /* fall through */
+ case am_mixed:
+ c_p->flags &= ~F_OFF_HEAP_MSGQ;
+ /*
+ * We are not allowed to clear ERTS_PSFLG_OFF_HEAP_MSGQ
+ * if a off heap change is ongoing. It will be adjusted
+ * when the change completes...
+ */
+ if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) {
+ /* Safe to clear ERTS_PSFLG_OFF_HEAP_MSGQ... */
+ erts_smp_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_OFF_HEAP_MSGQ);
+ }
+ break;
+ default:
+ res = THE_NON_VALUE; /* badarg */
+ break;
+ }
+ break;
+
+ case F_ON_HEAP_MSGQ:
+ res = am_on_heap;
+
+ switch (new_state) {
+ case am_on_heap:
+ break;
+ case am_mixed:
+ c_p->flags &= ~F_ON_HEAP_MSGQ;
+ erts_smp_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_ON_HEAP_MSGQ);
+ break;
+ case am_off_heap:
+ c_p->flags &= ~F_ON_HEAP_MSGQ;
+ erts_smp_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_ON_HEAP_MSGQ);
+ goto change_to_off_heap;
+ default:
+ res = THE_NON_VALUE; /* badarg */
+ break;
+ }
+ break;
+
+ case 0:
+ res = am_mixed;
+
+ switch (new_state) {
+ case am_mixed:
+ break;
+ case am_on_heap:
+ c_p->flags |= F_ON_HEAP_MSGQ;
+ erts_smp_atomic32_read_bor_nob(&c_p->state,
+ ERTS_PSFLG_ON_HEAP_MSGQ);
+ break;
+ case am_off_heap:
+ goto change_to_off_heap;
+ default:
+ res = THE_NON_VALUE; /* badarg */
+ break;
+ }
+ break;
+
+ default:
+ res = am_error;
+ ERTS_INTERNAL_ERROR("Inconsistent message queue management state");
+ break;
+ }
+
+ return res;
+
+change_to_off_heap:
+
+ c_p->flags |= F_OFF_HEAP_MSGQ;
+
+ /*
+ * We do not have to schedule a change if
+ * we have an ongoing off heap change...
+ */
+ if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) {
+ ErtsChangeOffHeapMessageQueue *cohmq;
+ /*
+ * Need to set ERTS_PSFLG_OFF_HEAP_MSGQ and wait
+ * thread progress before completing the change in
+ * order to ensure that all senders observe that
+ * messages should be passed off heap. When the
+ * change has completed, GC does not need to inspect
+ * the message queue at all.
+ */
+ erts_smp_atomic32_read_bor_nob(&c_p->state,
+ ERTS_PSFLG_OFF_HEAP_MSGQ);
+ c_p->flags |= F_OFF_HEAP_MSGQ_CHNG;
+ cohmq = erts_alloc(ERTS_ALC_T_MSGQ_CHNG,
+ sizeof(ErtsChangeOffHeapMessageQueue));
+ cohmq->pid = c_p->common.id;
+ erts_schedule_thr_prgr_later_op(change_off_heap_msgq,
+ (void *) cohmq,
+ &cohmq->lop);
+ }
+
+ return res;
+}
+
+int
+erts_decode_dist_message(Process *proc, ErtsProcLocks proc_locks,
+ ErtsMessage *msgp, int force_off_heap)
+{
+ ErtsHeapFactory factory;
+ Eterm msg;
+ ErlHeapFragment *bp;
+ Sint need;
+ int decode_in_heap_frag;
+
+ decode_in_heap_frag = (force_off_heap
+ || !(proc_locks & ERTS_PROC_LOCK_MAIN)
+ || (proc->flags & F_OFF_HEAP_MSGQ));
+
+ if (msgp->data.dist_ext->heap_size >= 0)
+ need = msgp->data.dist_ext->heap_size;
+ else {
+ need = erts_decode_dist_ext_size(msgp->data.dist_ext);
+ if (need < 0) {
+ /* bad msg; remove it... */
+ if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) {
+ bp = erts_dist_ext_trailer(msgp->data.dist_ext);
+ erts_cleanup_offheap(&bp->off_heap);
+ }
+ erts_free_dist_ext_copy(msgp->data.dist_ext);
+ msgp->data.dist_ext = NULL;
+ return 0;
+ }
+
+ msgp->data.dist_ext->heap_size = need;
+ }
+
+ if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) {
+ bp = erts_dist_ext_trailer(msgp->data.dist_ext);
+ need += bp->used_size;
+ }
+
+ if (decode_in_heap_frag)
+ erts_factory_heap_frag_init(&factory, new_message_buffer(need));
+ else
+ erts_factory_proc_prealloc_init(&factory, proc, need);
+
+ ASSERT(msgp->data.dist_ext->heap_size >= 0);
+ if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) {
+ ErlHeapFragment *heap_frag;
+ heap_frag = erts_dist_ext_trailer(msgp->data.dist_ext);
+ ERL_MESSAGE_TOKEN(msgp) = copy_struct(ERL_MESSAGE_TOKEN(msgp),
+ heap_frag->used_size,
+ &factory.hp,
+ factory.off_heap);
+ erts_cleanup_offheap(&heap_frag->off_heap);
+ }
+
+ msg = erts_decode_dist_ext(&factory, msgp->data.dist_ext);
+ ERL_MESSAGE_TERM(msgp) = msg;
+ erts_free_dist_ext_copy(msgp->data.dist_ext);
+ msgp->data.attached = NULL;
+
+ if (is_non_value(msg)) {
+ erts_factory_undo(&factory);
+ return 0;
+ }
+
+ erts_factory_trim_and_close(&factory, msgp->m,
+ ERL_MESSAGE_REF_ARRAY_SZ);
+
+ ASSERT(!msgp->data.heap_frag);
+
+ if (decode_in_heap_frag)
+ msgp->data.heap_frag = factory.heap_frags;
+
+ return 1;
+}
+
+/*
+ * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0 will move off heap messages
+ * into the heap of the inspected process if off_heap_message_queue
+ * is false when process_info(_, messages) is called. That is, the
+ * following GC will have more data in the rootset compared to the
+ * scenario when process_info(_, messages) had not been called.
+ *
+ * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS != 0 will keep off heap messages
+ * off heap when process_info(_, messages) is called regardless of
+ * the off_heap_message_queue setting of the process. That is, it
+ * will change the following execution of the process as little as
+ * possible.
+ */
+#define ERTS_INSPECT_MSGQ_KEEP_OH_MSGS 1
+
+Uint
+erts_prep_msgq_for_inspection(Process *c_p, Process *rp,
+ ErtsProcLocks rp_locks, ErtsMessageInfo *mip)
+{
+ Uint tot_heap_size;
+ ErtsMessage* mp;
+ Sint i;
+ int self_on_heap;
+
+ /*
+ * Prepare the message queue for inspection
+ * by process_info().
+ *
+ *
+ * - Decode all messages on external format
+ * - Remove all corrupt dist messages from queue
+ * - Save pointer to, and heap size need of each
+ * message in the mip array.
+ * - Return total heap size need for all messages
+ * that needs to be copied.
+ *
+ * If ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0:
+ * - In case off heap messages is disabled and
+ * we are inspecting our own queue, move all
+ * off heap data into the heap.
+ */
+
+ self_on_heap = c_p == rp && !(c_p->flags & F_OFF_HEAP_MSGQ);
+
+ tot_heap_size = 0;
+ i = 0;
+ mp = rp->msg.first;
+ while (mp) {
+ Eterm msg = ERL_MESSAGE_TERM(mp);
+
+ mip[i].size = 0;
+
+ if (is_non_value(msg)) {
+ /* Dist message on external format; decode it... */
+ if (mp->data.attached)
+ erts_decode_dist_message(rp, rp_locks, mp,
+ ERTS_INSPECT_MSGQ_KEEP_OH_MSGS);
+
+ msg = ERL_MESSAGE_TERM(mp);
+
+ if (is_non_value(msg)) {
+ ErtsMessage **mpp;
+ ErtsMessage *bad_mp = mp;
+ /*
+ * Bad distribution message; remove
+ * it from the queue...
+ */
+ ASSERT(!mp->data.attached);
+
+ mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next;
+
+ if (rp->msg.save == &bad_mp->next)
+ rp->msg.save = mpp;
+ if (rp->msg.last == &bad_mp->next)
+ rp->msg.last = mpp;
+ mp = mp->next;
+ *mpp = mp;
+ rp->msg.len--;
+ bad_mp->next = NULL;
+ erts_cleanup_messages(bad_mp);
+ continue;
+ }
+ }
+
+ ASSERT(is_value(msg));
+
+#if ERTS_INSPECT_MSGQ_KEEP_OH_MSGS
+ if (is_not_immed(msg) && (!self_on_heap || mp->data.attached)) {
+ Uint sz = size_object(msg);
+ mip[i].size = sz;
+ tot_heap_size += sz;
+ }
+#else
+ if (self_on_heap) {
+ if (mp->data.attached) {
+ ErtsMessage *tmp = NULL;
+ if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
+ erts_link_mbuf_to_proc(rp, mp->data.heap_frag);
+ mp->data.attached = NULL;
+ }
+ else {
+ /*
+ * Need to replace the message reference since
+ * we will get references to the message data
+ * from the heap...
+ */
+ ErtsMessage **mpp;
+ tmp = erts_alloc_message(0, NULL);
+ sys_memcpy((void *) tmp->m, (void *) mp->m,
+ sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ);
+ mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next;
+ tmp->next = mp->next;
+ if (rp->msg.save == &mp->next)
+ rp->msg.save = &tmp->next;
+ if (rp->msg.last == &mp->next)
+ rp->msg.last = &tmp->next;
+ *mpp = tmp;
+ erts_save_message_in_proc(rp, mp);
+ mp = tmp;
+ }
+ }
+ }
+ else if (is_not_immed(msg)) {
+ Uint sz = size_object(msg);
+ mip[i].size = sz;
+ tot_heap_size += sz;
+ }
+
+#endif
+
+ mip[i].msgp = mp;
+ i++;
+ mp = mp->next;
+ }
+
+ return tot_heap_size;
}
void erts_factory_proc_init(ErtsHeapFactory* factory,
@@ -1127,47 +1439,138 @@ void erts_factory_proc_prealloc_init(ErtsHeapFactory* factory,
Process* p,
Sint size)
{
+ ErlHeapFragment *bp = p->mbuf;
factory->mode = FACTORY_HALLOC;
factory->p = p;
factory->hp_start = HAlloc(p, size);
factory->hp = factory->hp_start;
factory->hp_end = factory->hp_start + size;
factory->off_heap = &p->off_heap;
+ factory->message = NULL;
factory->off_heap_saved.first = p->off_heap.first;
factory->off_heap_saved.overhead = p->off_heap.overhead;
- factory->heap_frags_saved = p->mbuf;
+ factory->heap_frags_saved = bp;
+ factory->heap_frags_saved_used = bp ? bp->used_size : 0;
factory->heap_frags = NULL; /* not used */
factory->alloc_type = 0; /* not used */
}
-void erts_factory_message_init(ErtsHeapFactory* factory,
- Process* rp,
- Eterm* hp,
- ErlHeapFragment* bp)
+void erts_factory_heap_frag_init(ErtsHeapFactory* factory,
+ ErlHeapFragment* bp)
{
- if (bp) {
- factory->mode = FACTORY_HEAP_FRAGS;
- factory->p = NULL;
- factory->hp_start = bp->mem;
- factory->hp = hp ? hp : bp->mem;
- factory->hp_end = bp->mem + bp->alloc_size;
- factory->off_heap = &bp->off_heap;
- factory->heap_frags = bp;
- factory->heap_frags_saved = bp;
- factory->alloc_type = ERTS_ALC_T_HEAP_FRAG;
- ASSERT(!bp->next);
+ factory->mode = FACTORY_HEAP_FRAGS;
+ factory->p = NULL;
+ factory->hp_start = bp->mem;
+ factory->hp = bp->mem;
+ factory->hp_end = bp->mem + bp->alloc_size;
+ factory->off_heap = &bp->off_heap;
+ factory->message = NULL;
+ factory->heap_frags = bp;
+ factory->heap_frags_saved = NULL;
+ factory->heap_frags_saved_used = 0;
+ factory->alloc_type = ERTS_ALC_T_HEAP_FRAG;
+ ASSERT(!bp->next);
+ factory->off_heap_saved.first = factory->off_heap->first;
+ factory->off_heap_saved.overhead = factory->off_heap->overhead;
+
+ ASSERT(factory->hp >= factory->hp_start && factory->hp <= factory->hp_end);
+}
+
+
+ErtsMessage *
+erts_factory_message_create(ErtsHeapFactory* factory,
+ Process *proc,
+ ErtsProcLocks *proc_locksp,
+ Uint sz)
+{
+ Eterm *hp;
+ ErlOffHeap *ohp;
+ ErtsMessage *msgp;
+ int on_heap;
+ erts_aint32_t state;
+
+ state = erts_smp_atomic32_read_nob(&proc->state);
+
+ if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) {
+ msgp = erts_alloc_message(sz, &hp);
+ ohp = sz == 0 ? NULL : &msgp->hfrag.off_heap;
+ on_heap = 0;
}
else {
- factory->mode = FACTORY_HALLOC;
- factory->p = rp;
- factory->hp_start = hp;
- factory->hp = hp;
- factory->hp_end = HEAP_TOP(rp);
- factory->off_heap = &rp->off_heap;
- factory->heap_frags_saved = rp->mbuf;
- factory->heap_frags = NULL; /* not used */
- factory->alloc_type = 0; /* not used */
+ 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;
@@ -1250,9 +1653,17 @@ static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
factory->hp_end = factory->hp + need;
return;
- case FACTORY_HEAP_FRAGS:
- case FACTORY_TMP:
- bp = factory->heap_frags;
+ case FACTORY_MESSAGE:
+ if (!factory->heap_frags) {
+ ASSERT(factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG);
+ bp = &factory->message->hfrag;
+ }
+ else {
+ /* Fall through */
+ case FACTORY_HEAP_FRAGS:
+ case FACTORY_TMP:
+ bp = factory->heap_frags;
+ }
if (bp) {
ASSERT(factory->hp > bp->mem);
@@ -1290,8 +1701,23 @@ void erts_factory_close(ErtsHeapFactory* factory)
HRelease(factory->p, factory->hp_end, factory->hp);
break;
- case FACTORY_HEAP_FRAGS:
- bp = factory->heap_frags;
+ case FACTORY_MESSAGE:
+ if (!factory->heap_frags) {
+ if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ bp = &factory->message->hfrag;
+ else
+ bp = NULL;
+ }
+ else {
+ if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ factory->message->hfrag.next = factory->heap_frags;
+ else
+ factory->message->data.heap_frag = factory->heap_frags;
+
+ /* Fall through */
+ case FACTORY_HEAP_FRAGS:
+ bp = factory->heap_frags;
+ }
if (bp) {
ASSERT(factory->hp >= bp->mem);
@@ -1315,17 +1741,47 @@ void erts_factory_close(ErtsHeapFactory* factory)
void erts_factory_trim_and_close(ErtsHeapFactory* factory,
Eterm *brefs, Uint brefs_size)
{
- if (factory->mode == FACTORY_HEAP_FRAGS) {
- ErlHeapFragment* bp = factory->heap_frags;
+ ErlHeapFragment *bp;
+
+ switch (factory->mode) {
+ case FACTORY_MESSAGE: {
+ ErtsMessage *mp = factory->message;
+ if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) {
+ if (!mp->hfrag.next) {
+ Uint sz = factory->hp - factory->hp_start;
+ mp = erts_shrink_message(mp, sz, brefs, brefs_size);
+ factory->message = mp;
+ factory->mode = FACTORY_CLOSED;
+ return;
+ }
+ /*else we don't trim multi fragmented messages for now (off_heap...) */
+ break;
+ }
+ /* Fall through... */
+ }
+ case FACTORY_HEAP_FRAGS:
+ bp = factory->heap_frags;
+ if (!bp)
+ break;
if (bp->next == NULL) {
Uint used_sz = factory->hp - bp->mem;
ASSERT(used_sz <= bp->alloc_size);
- factory->heap_frags = erts_resize_message_buffer(bp, used_sz,
- brefs, brefs_size);
+ if (used_sz > 0)
+ bp = erts_resize_message_buffer(bp, used_sz,
+ brefs, brefs_size);
+ else {
+ free_message_buffer(bp);
+ bp = NULL;
+ }
+ factory->heap_frags = bp;
+ if (factory->mode == FACTORY_MESSAGE)
+ factory->message->data.heap_frag = bp;
factory->mode = FACTORY_CLOSED;
return;
}
- /*else we don't trim multi fragmented messages for now */
+ /*else we don't trim multi fragmented messages for now (off_heap...) */
+ default:
+ break;
}
erts_factory_close(factory);
}
@@ -1373,28 +1829,33 @@ void erts_factory_undo(ErtsHeapFactory* factory)
/* Rollback heap top
*/
- if (factory->heap_frags_saved == NULL) { /* No heap frags when we started */
- ASSERT(factory->hp_start >= HEAP_START(factory->p));
- ASSERT(factory->hp_start <= HEAP_LIMIT(factory->p));
- HEAP_TOP(factory->p) = factory->hp_start;
- }
- else {
+ if (HEAP_START(factory->p) <= factory->hp_start
+ && factory->hp_start <= HEAP_LIMIT(factory->p)) {
+ HEAP_TOP(factory->p) = factory->hp_start;
+ }
+
+ /* Fix last heap frag */
+ if (factory->heap_frags_saved) {
ASSERT(factory->heap_frags_saved == factory->p->mbuf);
- if (factory->hp_start == factory->heap_frags_saved->mem) {
+ if (factory->hp_start != factory->heap_frags_saved->mem)
+ factory->heap_frags_saved->used_size = factory->heap_frags_saved_used;
+ else {
factory->p->mbuf = factory->p->mbuf->next;
ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, factory->heap_frags_saved,
ERTS_HEAP_FRAG_SIZE(factory->heap_frags_saved->alloc_size));
}
- else if (factory->hp_start != factory->hp_end) {
- unsigned remains = factory->hp_start - factory->heap_frags_saved->mem;
- ASSERT(remains > 0 && remains < factory->heap_frags_saved->used_size);
- factory->heap_frags_saved->used_size = remains;
- }
}
}
break;
+ case FACTORY_MESSAGE:
+ if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ factory->message->hfrag.next = factory->heap_frags;
+ else
+ factory->message->data.heap_frag = factory->heap_frags;
+ erts_cleanup_messages(factory->message);
+ break;
case FACTORY_TMP:
case FACTORY_HEAP_FRAGS:
erts_cleanup_offheap(factory->off_heap);
@@ -1422,4 +1883,3 @@ void erts_factory_undo(ErtsHeapFactory* factory)
factory->heap_frags = NULL;
#endif
}
-
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index 92ba3e571c..60035d15ae 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -24,6 +24,8 @@
struct proc_bin;
struct external_thing_;
+typedef struct erl_mesg ErtsMessage;
+
/*
* This struct represents data that must be updated by structure copy,
* but is stored outside of any heap.
@@ -32,9 +34,6 @@ struct external_thing_;
struct erl_off_heap_header {
Eterm thing_word;
Uint size;
-#if HALFWORD_HEAP
- void* dummy_ptr_padding__;
-#endif
struct erl_off_heap_header* next;
};
@@ -57,6 +56,7 @@ typedef struct {
enum {
FACTORY_CLOSED = 0,
FACTORY_HALLOC,
+ FACTORY_MESSAGE,
FACTORY_HEAP_FRAGS,
FACTORY_STATIC,
FACTORY_TMP
@@ -65,8 +65,10 @@ typedef struct {
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;
@@ -74,7 +76,10 @@ typedef struct {
void erts_factory_proc_init(ErtsHeapFactory*, Process*);
void erts_factory_proc_prealloc_init(ErtsHeapFactory*, Process*, Sint size);
-void erts_factory_message_init(ErtsHeapFactory*, Process*, Eterm* hp, struct erl_heap_fragment*);
+void erts_factory_heap_frag_init(ErtsHeapFactory*, struct erl_heap_fragment*);
+ErtsMessage *erts_factory_message_create(ErtsHeapFactory *, Process *,
+ ErtsProcLocks *, Uint sz);
+void erts_factory_selfcontained_message_init(ErtsHeapFactory*, ErtsMessage *, Eterm *);
void erts_factory_static_init(ErtsHeapFactory*, Eterm* hp, Uint size, ErlOffHeap*);
void erts_factory_tmp_init(ErtsHeapFactory*, Eterm* hp, Uint size, Uint32 atype);
void erts_factory_dummy_init(ErtsHeapFactory*);
@@ -96,6 +101,8 @@ void erts_factory_undo(ErtsHeapFactory*);
#include "external.h"
#include "erl_process.h"
+#define ERTS_INVALID_HFRAG_PTR ((ErlHeapFragment *) ~((UWord) 7))
+
/*
* This struct represents a heap fragment, which is used when there
* isn't sufficient room in the process heap and we can't do a GC.
@@ -110,33 +117,53 @@ struct erl_heap_fragment {
Eterm mem[1]; /* Data */
};
-typedef struct erl_mesg {
- struct erl_mesg* next; /* Next message */
- union {
- ErtsDistExternal *dist_ext;
- ErlHeapFragment *heap_frag;
- void *attached;
- } data;
+/* m[0] = message, m[1] = seq trace token */
+#define ERL_MESSAGE_REF_ARRAY_SZ 2
+#define ERL_MESSAGE_TERM(mp) ((mp)->m[0])
+#define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1])
+
#ifdef USE_VM_PROBES
- Eterm m[3]; /* m[0] = message, m[1] = seq trace token, m[3] = dynamic trace user tag */
+/* m[2] = dynamic trace user tag */
+#undef ERL_MESSAGE_REF_ARRAY_SZ
+#define ERL_MESSAGE_REF_ARRAY_SZ 3
+#define ERL_MESSAGE_DT_UTAG(mp) ((mp)->m[2])
#else
- Eterm m[2]; /* m[0] = message, m[1] = seq trace token */
#endif
-} ErlMessage;
-#define ERL_MESSAGE_TERM(mp) ((mp)->m[0])
-#define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1])
#ifdef USE_VM_PROBES
-#define ERL_MESSAGE_DT_UTAG(mp) ((mp)->m[2])
+#define have_no_seqtrace(T) ((T) == NIL || (T) == am_have_dt_utag)
+#else
+#define have_no_seqtrace(T) ((T) == NIL)
#endif
+#define have_seqtrace(T) (!have_no_seqtrace(T))
+
+#define ERL_MESSAGE_REF_FIELDS__ \
+ ErtsMessage *next; /* Next message */ \
+ union { \
+ ErtsDistExternal *dist_ext; \
+ ErlHeapFragment *heap_frag; \
+ void *attached; \
+ } data; \
+ Eterm m[ERL_MESSAGE_REF_ARRAY_SZ]
+
+
+typedef struct erl_msg_ref__ {
+ ERL_MESSAGE_REF_FIELDS__;
+} ErtsMessageRef;
+
+struct erl_mesg {
+ ERL_MESSAGE_REF_FIELDS__;
+
+ ErlHeapFragment hfrag;
+};
/* Size of default message buffer (erl_message.c) */
#define ERL_MESSAGE_BUF_SZ 500
typedef struct {
- ErlMessage* first;
- ErlMessage** last; /* point to the last next pointer */
- ErlMessage** save;
+ ErtsMessage* first;
+ ErtsMessage** last; /* point to the last next pointer */
+ ErtsMessage** save;
Sint len; /* queue length */
/*
@@ -144,14 +171,14 @@ typedef struct {
* recv_set/1 instructions.
*/
BeamInstr* mark; /* address to rec_loop/2 instruction */
- ErlMessage** saved_last; /* saved last pointer */
+ ErtsMessage** saved_last; /* saved last pointer */
} ErlMessageQueue;
#ifdef ERTS_SMP
typedef struct {
- ErlMessage* first;
- ErlMessage** last; /* point to the last next pointer */
+ ErtsMessage* first;
+ ErtsMessage** last; /* point to the last next pointer */
Sint len; /* queue length */
} ErlMessageInQueue;
@@ -202,7 +229,7 @@ do { \
/* Unlink current message */
#define UNLINK_MESSAGE(p,msgp) do { \
- ErlMessage* __mp = (msgp)->next; \
+ ErtsMessage* __mp = (msgp)->next; \
*(p)->msg.save = __mp; \
(p)->msg.len--; \
if (__mp == NULL) \
@@ -218,76 +245,33 @@ do { \
#define SAVE_MESSAGE(p) \
(p)->msg.save = &(*(p)->msg.save)->next
-/*
- * ErtsMoveMsgAttachmentIntoProc() moves data attached to a message
- * onto the heap of a process. The attached data is the content of
- * the the message either on the internal format or on the external
- * format, and also possibly a seq trace token on the internal format.
- * If the message content is on the external format, the decode might
- * fail. If the decoding fails, ERL_MESSAGE_TERM(M) will contain
- * THE_NON_VALUE. That is, ERL_MESSAGE_TERM(M) *has* to be checked
- * afterwards and taken care of appropriately.
- *
- * ErtsMoveMsgAttachmentIntoProc() will shallow copy to heap if
- * possible; otherwise, move to heap via garbage collection.
- *
- * ErtsMoveMsgAttachmentIntoProc() is used when receiveing messages
- * in process_main() and in hipe_check_get_msg().
- */
-
-#define ErtsMoveMsgAttachmentIntoProc(M, P, ST, HT, FC, SWPO, SWPI) \
-do { \
- if ((M)->data.attached) { \
- Uint need__ = erts_msg_attached_data_size((M)); \
- { SWPO ; } \
- if ((ST) - (HT) >= need__) { \
- ErtsHeapFactory factory__; \
- erts_factory_proc_prealloc_init(&factory__, (P), need__); \
- erts_move_msg_attached_data_to_heap(&factory__, (M)); \
- erts_factory_close(&factory__); \
- if ((P)->mbuf != NULL) { \
- /* Heap was exhausted by messages. This is a rare case */ \
- /* that can currently (OTP 18) only happen if hamts are */ \
- /* far exceeding the estimated heap size. Do GC. */ \
- (FC) -= erts_garbage_collect((P), 0, NULL, 0); \
- } \
- } \
- else { \
- (FC) -= erts_garbage_collect((P), 0, NULL, 0); \
- } \
- { SWPI ; } \
- ASSERT(!(M)->data.attached); \
- } \
-} while (0)
-
#define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0)
#define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \
(sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm))
-#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, DATA_WORDS) \
-do { \
- (HEAP_FRAG_P)->next = NULL; \
- (HEAP_FRAG_P)->alloc_size = (DATA_WORDS); \
- (HEAP_FRAG_P)->used_size = (DATA_WORDS); \
- (HEAP_FRAG_P)->off_heap.first = NULL; \
- (HEAP_FRAG_P)->off_heap.overhead = 0; \
-} while (0)
+#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, USED_WORDS, DATA_WORDS) \
+ do { \
+ (HEAP_FRAG_P)->next = NULL; \
+ (HEAP_FRAG_P)->alloc_size = (DATA_WORDS); \
+ (HEAP_FRAG_P)->used_size = (USED_WORDS); \
+ (HEAP_FRAG_P)->off_heap.first = NULL; \
+ (HEAP_FRAG_P)->off_heap.overhead = 0; \
+ } while (0)
void init_message(void);
-void free_message(ErlMessage *);
ErlHeapFragment* new_message_buffer(Uint);
ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint,
Eterm *, Uint);
void free_message_buffer(ErlHeapFragment *);
void erts_queue_dist_message(Process*, ErtsProcLocks*, ErtsDistExternal *, Eterm);
#ifdef USE_VM_PROBES
-void erts_queue_message_probe(Process*, ErtsProcLocks*, ErlHeapFragment*,
+void erts_queue_message_probe(Process*, ErtsProcLocks*, ErtsMessage*,
Eterm message, Eterm seq_trace_token, Eterm dt_utag);
#define erts_queue_message(RP,RL,BP,Msg,SEQ) \
erts_queue_message_probe((RP),(RL),(BP),(Msg),(SEQ),NIL)
#else
-void erts_queue_message(Process*, ErtsProcLocks*, ErlHeapFragment*,
+void erts_queue_message(Process*, ErtsProcLocks*, ErtsMessage*,
Eterm message, Eterm seq_trace_token);
#define erts_queue_message_probe(RP,RL,BP,Msg,SEQ,TAG) \
erts_queue_message((RP),(RL),(BP),(Msg),(SEQ))
@@ -296,20 +280,141 @@ void erts_deliver_exit_message(Eterm, Process*, ErtsProcLocks *, Eterm, Eterm);
Sint erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned);
void erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp);
-void erts_move_msg_mbuf_to_heap(Eterm**, ErlOffHeap*, ErlMessage *);
-
-Uint erts_msg_attached_data_size_aux(ErlMessage *msg);
-void erts_move_msg_attached_data_to_heap(ErtsHeapFactory*, ErlMessage *);
-Eterm erts_msg_distext2heap(Process *, ErtsProcLocks *, ErlHeapFragment **,
- Eterm *, ErtsDistExternal *);
+Uint erts_msg_attached_data_size_aux(ErtsMessage *msg);
void erts_cleanup_offheap(ErlOffHeap *offheap);
+void erts_save_message_in_proc(Process *p, ErtsMessage *msg);
+Sint erts_move_messages_off_heap(Process *c_p);
+Sint erts_complete_off_heap_message_queue_change(Process *c_p);
+Eterm erts_change_message_queue_management(Process *c_p, Eterm new_state);
+
+int erts_decode_dist_message(Process *, ErtsProcLocks, ErtsMessage *, int);
+
+void erts_cleanup_messages(ErtsMessage *mp);
+
+typedef struct {
+ Uint size;
+ ErtsMessage *msgp;
+} ErtsMessageInfo;
+
+Uint erts_prep_msgq_for_inspection(Process *c_p,
+ Process *rp,
+ ErtsProcLocks rp_locks,
+ ErtsMessageInfo *mip);
+
+void *erts_alloc_message_ref(void);
+void erts_free_message_ref(void *);
+#define ERTS_SMALL_FIX_MSG_SZ 10
+#define ERTS_MEDIUM_FIX_MSG_SZ 20
+#define ERTS_LARGE_FIX_MSG_SZ 30
+void *erts_alloc_small_message(void);
+void erts_free_small_message(void *mp);
+
+typedef struct {
+ ErtsMessage m;
+ Eterm data[ERTS_SMALL_FIX_MSG_SZ-1];
+} ErtsSmallFixSzMessage;
+
+typedef struct {
+ ErtsMessage m;
+ Eterm data[ERTS_MEDIUM_FIX_MSG_SZ-1];
+} ErtsMediumFixSzMessage;
+
+typedef struct {
+ ErtsMessage m;
+ Eterm data[ERTS_LARGE_FIX_MSG_SZ-1];
+} ErtsLargeFixSzMessage;
+
+ErtsMessage *erts_try_alloc_message_on_heap(Process *pp,
+ erts_aint32_t *psp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp,
+ int *on_heap_p);
+ErtsMessage *erts_realloc_shrink_message(ErtsMessage *mp, Uint sz,
+ Eterm *brefs, Uint brefs_size);
+
+ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp);
+ERTS_GLB_FORCE_INLINE ErtsMessage *erts_shrink_message(ErtsMessage *mp, Uint sz,
+ Eterm *brefs, Uint brefs_size);
+ERTS_GLB_FORCE_INLINE void erts_free_message(ErtsMessage *mp);
ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment*);
-ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg);
+ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg);
+
+#define ERTS_MSG_COMBINED_HFRAG ((void *) 0x1)
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp)
+{
+ ErtsMessage *mp;
+
+ if (sz == 0) {
+ mp = erts_alloc_message_ref();
+ mp->next = NULL;
+ ERL_MESSAGE_TERM(mp) = NIL;
+ mp->data.attached = NULL;
+ if (hpp)
+ *hpp = NULL;
+ return mp;
+ }
+
+ mp = erts_alloc(ERTS_ALC_T_MSG,
+ sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm));
+
+ mp->next = NULL;
+ ERL_MESSAGE_TERM(mp) = NIL;
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ ERTS_INIT_HEAP_FRAG(&mp->hfrag, sz, sz);
+
+ if (hpp)
+ *hpp = &mp->hfrag.mem[0];
+
+ return mp;
+}
+
+ERTS_GLB_FORCE_INLINE ErtsMessage *
+erts_shrink_message(ErtsMessage *mp, Uint sz, Eterm *brefs, Uint brefs_size)
+{
+ if (sz == 0) {
+ ErtsMessage *nmp;
+ if (!mp->data.attached)
+ return mp;
+ ASSERT(mp->data.attached == ERTS_MSG_COMBINED_HFRAG);
+ nmp = erts_alloc_message_ref();
+#ifdef DEBUG
+ if (brefs && brefs_size) {
+ int i;
+ for (i = 0; i < brefs_size; i++)
+ ASSERT(is_non_value(brefs[i]) || is_immed(brefs[i]));
+ }
+#endif
+ erts_free(ERTS_ALC_T_MSG, mp);
+ return nmp;
+ }
+
+ ASSERT(mp->data.attached == ERTS_MSG_COMBINED_HFRAG);
+ ASSERT(mp->hfrag.used_size >= sz);
+
+ if (sz >= (mp->hfrag.alloc_size - mp->hfrag.alloc_size / 16)) {
+ mp->hfrag.used_size = sz;
+ return mp;
+ }
+
+ return erts_realloc_shrink_message(mp, sz, brefs, brefs_size);
+}
+
+ERTS_GLB_FORCE_INLINE void erts_free_message(ErtsMessage *mp)
+{
+ if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG)
+ erts_free_message_ref(mp);
+ else
+ erts_free(ERTS_ALC_T_MSG, mp);
+}
+
ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp)
{
Uint sz = 0;
@@ -319,11 +424,17 @@ ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp)
return sz;
}
-ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg)
+ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg)
{
ASSERT(msg->data.attached);
- if (is_value(ERL_MESSAGE_TERM(msg)))
- return erts_used_frag_sz(msg->data.heap_frag);
+ if (is_value(ERL_MESSAGE_TERM(msg))) {
+ ErlHeapFragment *bp;
+ if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ bp = &msg->hfrag;
+ else
+ bp = msg->data.heap_frag;
+ return erts_used_frag_sz(bp);
+ }
else if (msg->data.dist_ext->heap_size < 0)
return erts_msg_attached_data_size_aux(msg);
else {
diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c
new file mode 100644
index 0000000000..71e3fd8b6e
--- /dev/null
+++ b/erts/emulator/beam/erl_msacc.c
@@ -0,0 +1,486 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014-2015. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Description: Microstate accounting.
+ *
+ * We keep track of the different states that the
+ * Erlang VM threads are in, in order to provide
+ * performance/debugging statistics. There is a
+ * small overhead in enabling this, but in the big
+ * scheme of things it should be negligible.
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#define ERTS_MSACC_STATE_STRINGS 1
+
+#include "sys.h"
+#include "global.h"
+#include "erl_threads.h"
+#include "erl_bif_unique.h"
+#include "erl_map.h"
+#include "erl_msacc.h"
+
+#if ERTS_ENABLE_MSACC
+
+static Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp);
+static void erts_msacc_reset(ErtsMsAcc *msacc);
+static ErtsMsAcc* get_msacc(void);
+
+#ifdef USE_THREADS
+erts_tsd_key_t ERTS_WRITE_UNLIKELY(erts_msacc_key);
+#else
+ErtsMsAcc *ERTS_WRITE_UNLIKELY(erts_msacc) = NULL;
+#endif
+int ERTS_WRITE_UNLIKELY(erts_msacc_enabled);
+
+static Eterm *erts_msacc_state_atoms = NULL;
+static erts_rwmtx_t msacc_mutex;
+static ErtsMsAcc *msacc_managed = NULL;
+#ifdef USE_THREADS
+static ErtsMsAcc *msacc_unmanaged = NULL;
+static Uint msacc_unmanaged_count = 0;
+#endif
+
+/* we have to split initiation as atoms are not inited in early init */
+void erts_msacc_early_init(void) {
+#ifndef ERTS_MSACC_ALWAYS_ON
+ erts_msacc_enabled = 0;
+#endif
+ erts_rwmtx_init(&msacc_mutex,"msacc_list_mutex");
+#ifdef USE_THREADS
+ erts_tsd_key_create(&erts_msacc_key,"erts_msacc_key");
+#else
+ erts_msacc = NULL;
+#endif
+}
+
+void erts_msacc_init(void) {
+ int i;
+ erts_msacc_state_atoms = erts_alloc(ERTS_ALC_T_MSACC,
+ sizeof(Eterm)*ERTS_MSACC_STATE_COUNT);
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ erts_msacc_state_atoms[i] = am_atom_put(erts_msacc_states[i],
+ strlen(erts_msacc_states[i]));
+ }
+}
+
+void erts_msacc_init_thread(char *type, int id, int managed) {
+ ErtsMsAcc *msacc;
+
+ msacc = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMsAcc));
+
+ msacc->type = strdup(type);
+ msacc->id = make_small(id);
+ msacc->unmanaged = !managed;
+ msacc->tid = erts_thr_self();
+ msacc->perf_counter = 0;
+
+#ifdef USE_THREADS
+ erts_rwmtx_rwlock(&msacc_mutex);
+ if (!managed) {
+ erts_mtx_init(&msacc->mtx,"msacc_unmanaged_mutex");
+ msacc->next = msacc_unmanaged;
+ msacc_unmanaged = msacc;
+ msacc_unmanaged_count++;
+ ERTS_MSACC_TSD_SET(msacc);
+ } else {
+ msacc->next = msacc_managed;
+ msacc_managed = msacc;
+ }
+ erts_rwmtx_rwunlock(&msacc_mutex);
+#else
+ msacc_managed = msacc;
+#endif
+
+ erts_msacc_reset(msacc);
+
+#ifdef ERTS_MSACC_ALWAYS_ON
+ ERTS_MSACC_TSD_SET(msacc);
+ msacc->perf_counter = erts_sys_perf_counter();
+ msacc->state = ERTS_MSACC_STATE_OTHER;
+#endif
+}
+
+/*
+ * Creates a structure looking like this
+ * #{ type => scheduler, id => 1, counters => #{ State1 => Counter1 ... StateN => CounterN}}
+ */
+static
+Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp) {
+ int i;
+ Eterm *hp;
+ Eterm key, state_key, state_map;
+ Eterm res = THE_NON_VALUE;
+ flatmap_t *map;
+
+ if (szp) {
+ *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(3);
+ *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(ERTS_MSACC_STATE_COUNT);
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ (void)erts_bld_sint64(NULL,szp,(Sint64)msacc->perf_counters[i]);
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ (void)erts_bld_uint64(NULL,szp,msacc->state_counters[i]);
+ *szp += 3; /* tuple to put state+perf counter in */
+#endif
+ }
+ }
+
+ if (hpp) {
+ Eterm counters[ERTS_MSACC_STATE_COUNT];
+ hp = *hpp;
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ Eterm counter = erts_bld_sint64(&hp,NULL,(Sint64)msacc->perf_counters[i]);
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ Eterm counter__ = erts_bld_uint64(&hp,NULL,msacc->state_counters[i]);
+ counters[i] = TUPLE2(hp,counter,counter__);
+ hp += 3;
+#else
+ counters[i] = counter;
+#endif
+ }
+
+ key = TUPLE3(hp,am_counters,am_id,am_type);
+ hp += 4;
+
+ state_key = make_tuple(hp);
+ hp[0] = make_arityval(ERTS_MSACC_STATE_COUNT);
+
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++)
+ hp[1+i] = erts_msacc_state_atoms[i];
+ hp += 1 + ERTS_MSACC_STATE_COUNT;
+
+ map = (flatmap_t*)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ map->thing_word = MAP_HEADER_FLATMAP;
+ map->size = ERTS_MSACC_STATE_COUNT;
+ map->keys = state_key;
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++)
+ hp[i] = counters[i];
+ hp += ERTS_MSACC_STATE_COUNT;
+ state_map = make_flatmap(map);
+
+ map = (flatmap_t*)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ map->thing_word = MAP_HEADER_FLATMAP;
+ map->size = 3;
+ map->keys = key;
+ hp[0] = state_map;
+ hp[1] = msacc->id;
+ hp[2] = am_atom_put(msacc->type,strlen(msacc->type));
+ hp += 3;
+
+ *hpp = hp;
+ res = make_flatmap(map);
+ }
+
+ return res;
+}
+
+typedef struct {
+ int action;
+ Process *proc;
+ Eterm ref;
+ Eterm ref_heap[REF_THING_SIZE];
+ Uint req_sched;
+ erts_smp_atomic32_t refc;
+} ErtsMSAccReq;
+
+static ErtsMsAcc* get_msacc(void) {
+ ErtsMsAcc *msacc;
+ erts_rwmtx_rlock(&msacc_mutex);
+ msacc = msacc_managed;
+ while (!erts_equal_tids(msacc->tid,erts_thr_self())) {
+ msacc = msacc->next;
+ ASSERT(msacc != NULL);
+ }
+ erts_rwmtx_runlock(&msacc_mutex);
+ return msacc;
+}
+
+static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) {
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ Process *rp = msaccrp->proc;
+ ErtsMessage *msgp = NULL;
+ Eterm **hpp, *hp;
+ Eterm ref_copy = NIL, msg;
+ Uint sz, *szp;
+ ErlOffHeap *ohp = NULL;
+ ErtsProcLocks rp_locks = (esdp && msaccrp->req_sched == esdp->no
+ ? ERTS_PROC_LOCK_MAIN : 0);
+
+ sz = 0;
+ hpp = NULL;
+ szp = &sz;
+
+ if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx);
+
+ while (1) {
+ if (hpp)
+ ref_copy = STORE_NC(hpp, ohp, msaccrp->ref);
+ else
+ *szp += REF_THING_SIZE;
+
+ if (msaccrp->action != ERTS_MSACC_GATHER)
+ msg = ref_copy;
+ else {
+ msg = erts_msacc_gather_stats(msacc, hpp, szp);
+ msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg);
+ }
+ if (hpp)
+ break;
+
+ msgp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
+ hpp = &hp;
+ szp = NULL;
+ }
+
+ if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx);
+
+ erts_queue_message(rp, &rp_locks, msgp, msg, NIL);
+
+ if (esdp && msaccrp->req_sched == esdp->no)
+ rp_locks &= ~ERTS_PROC_LOCK_MAIN;
+
+ if (rp_locks)
+ erts_smp_proc_unlock(rp, rp_locks);
+
+}
+
+static void
+reply_msacc(void *vmsaccrp)
+{
+ ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET();
+ ErtsMSAccReq *msaccrp = (ErtsMSAccReq *) vmsaccrp;
+
+ ASSERT(!msacc || !msacc->unmanaged);
+
+ if (msaccrp->action == ERTS_MSACC_ENABLE && !msacc) {
+ msacc = get_msacc();
+
+ msacc->perf_counter = erts_sys_perf_counter();
+
+ msacc->state = ERTS_MSACC_STATE_OTHER;
+
+ ERTS_MSACC_TSD_SET(msacc);
+
+ } else if (msaccrp->action == ERTS_MSACC_DISABLE && msacc) {
+ ERTS_MSACC_TSD_SET(NULL);
+ } else if (msaccrp->action == ERTS_MSACC_RESET) {
+ msacc = msacc ? msacc : get_msacc();
+ erts_msacc_reset(msacc);
+ } else if (msaccrp->action == ERTS_MSACC_GATHER && !msacc) {
+ msacc = get_msacc();
+ }
+
+ ASSERT(!msacc || !msacc->unmanaged);
+
+ send_reply(msacc, msaccrp);
+
+ erts_proc_dec_refc(msaccrp->proc);
+
+ if (erts_smp_atomic32_dec_read_nob(&msaccrp->refc) == 0)
+ erts_free(ERTS_ALC_T_MSACC, vmsaccrp);
+}
+
+static void erts_msacc_reset(ErtsMsAcc *msacc) {
+ int i;
+ if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx);
+
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ msacc->perf_counters[i] = 0;
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ msacc->state_counters[i] = 0;
+#endif
+ }
+
+ if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx);
+}
+
+#endif /* ERTS_ENABLE_MSACC */
+
+
+/*
+ * This function is responsible for enabling, disabling, resetting and
+ * gathering data related to microstate accounting.
+ *
+ * Managed threads and unmanaged threads are handled differently.
+ * - managed threads get a misc_aux job telling them to switch on msacc
+ * - unmanaged have some fields protected by a mutex that has to be taken
+ * before any values can be updated
+ *
+ * For performance reasons there is also a global value erts_msacc_enabled
+ * that controls the state of all threads. Statistics gathering is only on
+ * if erts_msacc_enabled && msacc is true.
+ */
+Eterm
+erts_msacc_request(Process *c_p, int action, Eterm *threads)
+{
+#ifdef ERTS_ENABLE_MSACC
+ ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET();
+ ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p);
+ Eterm ref;
+ ErtsMSAccReq *msaccrp;
+ Eterm *hp;
+
+
+#ifdef ERTS_MSACC_ALWAYS_ON
+ if (action == ERTS_MSACC_ENABLE || action == ERTS_MSACC_DISABLE)
+ return THE_NON_VALUE;
+#else
+ /* take care of double enable, and double disable here */
+ if (msacc && action == ERTS_MSACC_ENABLE) {
+ return THE_NON_VALUE;
+ } else if (!msacc && action == ERTS_MSACC_DISABLE) {
+ return THE_NON_VALUE;
+ }
+#endif
+
+ ref = erts_make_ref(c_p);
+
+ msaccrp = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMSAccReq));
+ hp = &msaccrp->ref_heap[0];
+
+ msaccrp->action = action;
+ msaccrp->proc = c_p;
+ msaccrp->ref = STORE_NC(&hp, NULL, ref);
+ msaccrp->req_sched = esdp->no;
+
+#ifdef ERTS_SMP
+ *threads = erts_no_schedulers;
+ *threads += 1; /* aux thread */
+#else
+ *threads = 1;
+#endif
+
+ erts_smp_atomic32_init_nob(&msaccrp->refc,(erts_aint32_t)*threads);
+
+ erts_proc_add_refc(c_p, *threads);
+
+ if (erts_no_schedulers > 1)
+ erts_schedule_multi_misc_aux_work(1,
+ erts_no_schedulers,
+ reply_msacc,
+ (void *) msaccrp);
+#ifdef ERTS_SMP
+ /* aux thread */
+ erts_schedule_misc_aux_work(0, reply_msacc, (void *) msaccrp);
+#endif
+
+#ifdef USE_THREADS
+ /* Manage unmanaged threads */
+ switch (action) {
+ case ERTS_MSACC_GATHER: {
+ Uint unmanaged_count;
+ ErtsMsAcc *msacc, **unmanaged;
+ int i = 0;
+
+ /* we copy a list of pointers here so that we do not have to have
+ the msacc_mutex when sending messages */
+ erts_rwmtx_rlock(&msacc_mutex);
+ unmanaged_count = msacc_unmanaged_count;
+ unmanaged = erts_alloc(ERTS_ALC_T_MSACC,
+ sizeof(ErtsMsAcc*)*unmanaged_count);
+
+ for (i = 0, msacc = msacc_unmanaged;
+ i < unmanaged_count;
+ i++, msacc = msacc->next) {
+ unmanaged[i] = msacc;
+ }
+ erts_rwmtx_runlock(&msacc_mutex);
+
+ for (i = 0; i < unmanaged_count; i++) {
+ erts_mtx_lock(&unmanaged[i]->mtx);
+ if (unmanaged[i]->perf_counter) {
+ ErtsSysPerfCounter perf_counter;
+ /* if enabled update stats */
+ perf_counter = erts_sys_perf_counter();
+ unmanaged[i]->perf_counters[unmanaged[i]->state] +=
+ perf_counter - unmanaged[i]->perf_counter;
+ unmanaged[i]->perf_counter = perf_counter;
+ }
+ erts_mtx_unlock(&unmanaged[i]->mtx);
+ send_reply(unmanaged[i],msaccrp);
+ }
+ erts_free(ERTS_ALC_T_MSACC,unmanaged);
+ /* We have just sent unmanaged_count messages, so bump no of threads */
+ *threads += unmanaged_count;
+ break;
+ }
+ case ERTS_MSACC_RESET: {
+ ErtsMsAcc *msacc;
+ erts_rwmtx_rlock(&msacc_mutex);
+ for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next)
+ erts_msacc_reset(msacc);
+ erts_rwmtx_runlock(&msacc_mutex);
+ break;
+ }
+ case ERTS_MSACC_ENABLE: {
+ erts_rwmtx_rlock(&msacc_mutex);
+ for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) {
+ erts_mtx_lock(&msacc->mtx);
+ msacc->perf_counter = erts_sys_perf_counter();
+ /* we assume the unmanaged thread is sleeping */
+ msacc->state = ERTS_MSACC_STATE_SLEEP;
+ erts_mtx_unlock(&msacc->mtx);
+ }
+ erts_rwmtx_runlock(&msacc_mutex);
+ break;
+ }
+ case ERTS_MSACC_DISABLE: {
+ ErtsSysPerfCounter perf_counter;
+ erts_rwmtx_rlock(&msacc_mutex);
+ /* make sure to update stats with latest results */
+ for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) {
+ erts_mtx_lock(&msacc->mtx);
+ perf_counter = erts_sys_perf_counter();
+ msacc->perf_counters[msacc->state] += perf_counter - msacc->perf_counter;
+ msacc->perf_counter = 0;
+ erts_mtx_unlock(&msacc->mtx);
+ }
+ erts_rwmtx_runlock(&msacc_mutex);
+ break;
+ }
+ default: { ASSERT(0); }
+ }
+
+#endif
+
+ *threads = make_small(*threads);
+
+ reply_msacc((void *) msaccrp);
+
+#ifndef ERTS_MSACC_ALWAYS_ON
+ /* enable/disable the global value */
+ if (action == ERTS_MSACC_ENABLE) {
+ erts_msacc_enabled = 1;
+ } else if (action == ERTS_MSACC_DISABLE) {
+ erts_msacc_enabled = 0;
+ }
+#endif
+
+ return ref;
+#else
+ return THE_NON_VALUE;
+#endif
+}
diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h
new file mode 100644
index 0000000000..284388f7aa
--- /dev/null
+++ b/erts/emulator/beam/erl_msacc.h
@@ -0,0 +1,409 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014-2015. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifndef ERL_MSACC_H__
+#define ERL_MSACC_H__
+
+/* Can be enabled/disabled via configure */
+#if ERTS_ENABLE_MSACC == 2
+#define ERTS_MSACC_EXTENDED_STATES 1
+#endif
+
+/* Uncomment this to also count the number of
+ transitions to a state. This will add a count
+ to the counter map. */
+/* #define ERTS_MSACC_STATE_COUNTERS 1 */
+
+/* Uncomment this to make msacc to always be on,
+ this reduces overhead a little bit when profiling */
+/* #define ERTS_MSACC_ALWAYS_ON 1 */
+
+#define ERTS_MSACC_DISABLE 0
+#define ERTS_MSACC_ENABLE 1
+#define ERTS_MSACC_RESET 2
+#define ERTS_MSACC_GATHER 3
+
+/*
+ * When adding a new state, you have to:
+ * * Add it here
+ * * Increment ERTS_MSACC_STATE_COUNT
+ * * Add string value to erts_msacc_states
+ * * Have to be in alphabetical order!
+ * * Only add states to the non-extended section after
+ * careful benchmarking to make sure the overhead
+ * when disabled is minimal.
+ */
+
+#ifndef ERTS_MSACC_EXTENDED_STATES
+#define ERTS_MSACC_STATE_AUX 0
+#define ERTS_MSACC_STATE_CHECK_IO 1
+#define ERTS_MSACC_STATE_EMULATOR 2
+#define ERTS_MSACC_STATE_GC 3
+#define ERTS_MSACC_STATE_OTHER 4
+#define ERTS_MSACC_STATE_PORT 5
+#define ERTS_MSACC_STATE_SLEEP 6
+
+#define ERTS_MSACC_STATE_COUNT 7
+
+#if ERTS_MSACC_STATE_STRINGS && ERTS_ENABLE_MSACC
+static char *erts_msacc_states[] = {
+ "aux",
+ "check_io",
+ "emulator",
+ "gc",
+ "other",
+ "port",
+ "sleep"
+};
+#endif
+
+#else
+
+#define ERTS_MSACC_STATE_ALLOC 0
+#define ERTS_MSACC_STATE_AUX 1
+#define ERTS_MSACC_STATE_BIF 2
+#define ERTS_MSACC_STATE_BUSY_WAIT 3
+#define ERTS_MSACC_STATE_CHECK_IO 4
+#define ERTS_MSACC_STATE_EMULATOR 5
+#define ERTS_MSACC_STATE_ETS 6
+#define ERTS_MSACC_STATE_GC 7
+#define ERTS_MSACC_STATE_GC_FULL 8
+#define ERTS_MSACC_STATE_NIF 9
+#define ERTS_MSACC_STATE_OTHER 10
+#define ERTS_MSACC_STATE_PORT 11
+#define ERTS_MSACC_STATE_SEND 12
+#define ERTS_MSACC_STATE_SLEEP 13
+#define ERTS_MSACC_STATE_TIMERS 14
+
+#define ERTS_MSACC_STATE_COUNT 15
+
+#if ERTS_MSACC_STATE_STRINGS
+static char *erts_msacc_states[] = {
+ "alloc",
+ "aux",
+ "bif",
+ "busy_wait",
+ "check_io",
+ "emulator",
+ "ets",
+ "gc",
+ "gc_full",
+ "nif",
+ "other",
+ "port",
+ "send",
+ "sleep",
+ "timers"
+};
+#endif
+
+#endif
+
+typedef struct erl_msacc_t_ ErtsMsAcc;
+
+struct erl_msacc_t_ {
+
+ /* the the values below are protected by mtx iff unmanaged = 1 */
+ ErtsSysPerfCounter perf_counter;
+ ErtsSysPerfCounter perf_counters[ERTS_MSACC_STATE_COUNT];
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ Uint64 state_counters[ERTS_MSACC_STATE_COUNT];
+#endif
+ Uint state;
+
+ /* protected by msacc_mutex in erl_msacc.c, and should be constant */
+ int unmanaged;
+ erts_mtx_t mtx;
+ ErtsMsAcc *next;
+ erts_tid_t tid;
+ Eterm id;
+ char *type;
+};
+
+#if ERTS_ENABLE_MSACC
+
+#define ERTS_MSACC_INLINE ERTS_GLB_INLINE
+
+#ifdef USE_THREADS
+extern erts_tsd_key_t erts_msacc_key;
+#else
+extern ErtsMsAcc *erts_msacc;
+#endif
+
+#ifdef ERTS_MSACC_ALWAYS_ON
+#define erts_msacc_enabled 1
+#else
+extern int erts_msacc_enabled;
+#endif
+
+#ifdef USE_THREADS
+#define ERTS_MSACC_TSD_GET() erts_tsd_get(erts_msacc_key)
+#define ERTS_MSACC_TSD_SET(tsd) erts_tsd_set(erts_msacc_key,tsd)
+#else
+#define ERTS_MSACC_TSD_GET() erts_msacc
+#define ERTS_MSACC_TSD_SET(tsd) erts_msacc = tsd
+#endif
+
+void erts_msacc_early_init(void);
+void erts_msacc_init(void);
+void erts_msacc_init_thread(char *type, int id, int liberty);
+
+/* The defines below are used to instrument the vm code
+ * with different state changes. There are two variants
+ * of each define. One that has a cached ErtsMsAcc *
+ * that it can use, and one that does not.
+ * The cached values are necessary to have in order to get
+ * low enough overhead when running without msacc enabled.
+ *
+ * The two most common patterns to use the function with are:
+ *
+ * ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_NEWSTATE);
+ * ... call other function in new state ...
+ * ERTS_MSACC_POP_STATE();
+ *
+ * Note that the erts_msacc_push* function declare new variables, so
+ * to conform with C89 we have to call it in the beginning of a function.
+ * We might not want to change state it the beginning though, so we use this:
+ *
+ * ERTS_MSACC_PUSH_STATE();
+ * ... some other code ...
+ * ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_NEWSTATE);
+ * ... call other function in new state ...
+ * ERTS_MSACC_POP_STATE();
+ *
+ * Notice that we used the cached version of set_state as push_state already
+ * read the erts_msacc_enabled to the cache.
+ *
+ * Most macros also have other variants with the suffix _m which means that
+ * they are known to only be called in managed threads, or with the _x suffix
+ * which means that it should only be used in an emulator compiled with
+ * extended states.
+ *
+ * Here is a listing of the entire api:
+ *
+ * void ERTS_MSACC_DECLARE_CACHE()
+ * void ERTS_MSACC_UPDATE_CACHE()
+ * void ERTS_MSACC_IS_ENABLED()
+ * void ERTS_MSACC_IS_ENABLED_CACHED()
+ *
+ * void ERTS_MSACC_PUSH_STATE()
+ * void ERTS_MSACC_SET_STATE(int state)
+ * void ERTS_MSACC_PUSH_AND_SET_STATE(int state)
+ *
+ * void ERTS_MSACC_PUSH_STATE_CACHED()
+ * void ERTS_MSACC_SET_STATE_CACHED(int state)
+ * void ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(int state)
+ * void ERTS_MSACC_POP_STATE()
+ *
+ * void ERTS_MSACC_PUSH_STATE_M()
+ * void ERTS_MSACC_PUSH_STATE_CACHED_M()
+ * void ERTS_MSACC_SET_STATE_CACHED_M(int state)
+ * void ERTS_MSACC_SET_STATE_M(int state)
+ * void ERTS_MSACC_POP_STATE_M()
+ * void ERTS_MSACC_PUSH_AND_SET_STATE_M(int state)
+ *
+ * Most functions are also available with an _x suffix that are only enabled
+ * when using the extra states. If they are not, just add them to the end
+ * of this file.
+ */
+
+/* cache handling functions */
+#define ERTS_MSACC_IS_ENABLED() ERTS_UNLIKELY(erts_msacc_enabled)
+#define ERTS_MSACC_DECLARE_CACHE() \
+ ErtsMsAcc *ERTS_MSACC_UPDATE_CACHE(); \
+ ERTS_DECLARE_DUMMY(Uint __erts_msacc_state) = ERTS_MSACC_STATE_OTHER;
+#define ERTS_MSACC_IS_ENABLED_CACHED() ERTS_UNLIKELY(__erts_msacc_cache != NULL)
+#define ERTS_MSACC_UPDATE_CACHE() \
+ __erts_msacc_cache = erts_msacc_enabled ? ERTS_MSACC_TSD_GET() : NULL
+
+
+/* The defines below implicitly declare and load a new cache */
+#define ERTS_MSACC_PUSH_STATE() \
+ ERTS_MSACC_DECLARE_CACHE(); \
+ ERTS_MSACC_PUSH_STATE_CACHED()
+#define ERTS_MSACC_SET_STATE(state) \
+ ERTS_MSACC_DECLARE_CACHE(); \
+ ERTS_MSACC_SET_STATE_CACHED(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE(state) \
+ ERTS_MSACC_PUSH_STATE(); ERTS_MSACC_SET_STATE_CACHED(state)
+
+/* The defines below need an already declared cache to work */
+#define ERTS_MSACC_PUSH_STATE_CACHED() \
+ __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \
+ erts_msacc_get_state_um__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER
+#define ERTS_MSACC_SET_STATE_CACHED(state) \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) \
+ erts_msacc_set_state_um__(__erts_msacc_cache, state, 1)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) \
+ ERTS_MSACC_PUSH_STATE_CACHED(); ERTS_MSACC_SET_STATE_CACHED(state)
+#define ERTS_MSACC_POP_STATE() \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) \
+ erts_msacc_set_state_um__(__erts_msacc_cache, __erts_msacc_state, 0)
+
+/* Only use these defines when we know that we have in a managed thread */
+#define ERTS_MSACC_PUSH_STATE_M() \
+ ERTS_MSACC_DECLARE_CACHE(); \
+ ERTS_MSACC_PUSH_STATE_CACHED_M()
+#define ERTS_MSACC_PUSH_STATE_CACHED_M() \
+ __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \
+ erts_msacc_get_state_m__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER
+#define ERTS_MSACC_SET_STATE_M(state) \
+ ERTS_MSACC_DECLARE_CACHE(); \
+ ERTS_MSACC_SET_STATE_CACHED_M(state)
+#define ERTS_MSACC_SET_STATE_CACHED_M(state) \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) \
+ erts_msacc_set_state_m__(__erts_msacc_cache, state, 1)
+#define ERTS_MSACC_POP_STATE_M() \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) \
+ erts_msacc_set_state_m__(__erts_msacc_cache, __erts_msacc_state, 0)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) \
+ ERTS_MSACC_PUSH_STATE_M(); ERTS_MSACC_SET_STATE_CACHED_M(state)
+
+ERTS_MSACC_INLINE
+void erts_msacc_set_state_um__(ErtsMsAcc *msacc,Uint state,int increment);
+ERTS_MSACC_INLINE
+void erts_msacc_set_state_m__(ErtsMsAcc *msacc,Uint state,int increment);
+
+ERTS_MSACC_INLINE
+Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc);
+ERTS_MSACC_INLINE
+Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc);
+
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_MSACC_INLINE
+Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc) {
+ Uint state;
+ if (msacc->unmanaged)
+ erts_mtx_lock(&msacc->mtx);
+ state = msacc->state;
+ if (msacc->unmanaged)
+ erts_mtx_unlock(&msacc->mtx);
+ return state;
+}
+
+ERTS_MSACC_INLINE
+Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc) {
+ return msacc->state;
+}
+
+ERTS_MSACC_INLINE
+void erts_msacc_set_state_um__(ErtsMsAcc *msacc, Uint new_state, int increment) {
+ if (ERTS_UNLIKELY(msacc->unmanaged)) {
+ erts_mtx_lock(&msacc->mtx);
+ msacc->state = new_state;
+ if (ERTS_LIKELY(!msacc->perf_counter)) {
+ erts_mtx_unlock(&msacc->mtx);
+ return;
+ }
+ }
+
+ erts_msacc_set_state_m__(msacc,new_state,increment);
+
+ if (ERTS_UNLIKELY(msacc->unmanaged))
+ erts_mtx_unlock(&msacc->mtx);
+}
+
+ERTS_MSACC_INLINE
+void erts_msacc_set_state_m__(ErtsMsAcc *msacc, Uint new_state, int increment) {
+ ErtsSysPerfCounter prev_perf_counter;
+ Sint64 diff;
+
+ if (new_state == msacc->state)
+ return;
+
+ prev_perf_counter = msacc->perf_counter;
+ msacc->perf_counter = erts_sys_perf_counter();
+ diff = msacc->perf_counter - prev_perf_counter;
+ ASSERT(diff >= 0);
+ msacc->perf_counters[msacc->state] += diff;
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ msacc->state_counters[new_state] += increment;
+#endif
+ msacc->state = new_state;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#else
+
+#define ERTS_MSACC_IS_ENABLED() 0
+#define erts_msacc_early_init()
+#define erts_msacc_init()
+#define erts_msacc_init_thread(type, id, liberty)
+#define ERTS_MSACC_PUSH_STATE()
+#define ERTS_MSACC_PUSH_STATE_CACHED()
+#define ERTS_MSACC_POP_STATE()
+#define ERTS_MSACC_SET_STATE(state)
+#define ERTS_MSACC_SET_STATE_CACHED(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state)
+#define ERTS_MSACC_UPDATE_CACHE()
+#define ERTS_MSACC_IS_ENABLED_CACHED()
+#define ERTS_MSACC_DECLARE_CACHE()
+#define ERTS_MSACC_PUSH_STATE_M()
+#define ERTS_MSACC_PUSH_STATE_CACHED_M()
+#define ERTS_MSACC_SET_STATE_CACHED_M(state)
+#define ERTS_MSACC_POP_STATE_M()
+#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state)
+
+
+#endif /* ERTS_ENABLE_MSACC */
+
+#ifndef ERTS_MSACC_EXTENDED_STATES
+
+#define ERTS_MSACC_PUSH_STATE_X()
+#define ERTS_MSACC_POP_STATE_X()
+#define ERTS_MSACC_SET_STATE_X(state)
+#define ERTS_MSACC_SET_STATE_M_X(state)
+#define ERTS_MSACC_SET_STATE_CACHED_X(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state)
+#define ERTS_MSACC_UPDATE_CACHE_X()
+#define ERTS_MSACC_IS_ENABLED_CACHED_X() 0
+#define ERTS_MSACC_DECLARE_CACHE_X()
+#define ERTS_MSACC_PUSH_STATE_M_X()
+#define ERTS_MSACC_PUSH_STATE_CACHED_M_X()
+#define ERTS_MSACC_SET_STATE_CACHED_M_X(state)
+#define ERTS_MSACC_POP_STATE_M_X()
+#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state)
+
+#else
+
+#define ERTS_MSACC_PUSH_STATE_X() ERTS_MSACC_PUSH_STATE()
+#define ERTS_MSACC_POP_STATE_X() ERTS_MSACC_POP_STATE()
+#define ERTS_MSACC_SET_STATE_X(state) ERTS_MSACC_SET_STATE(state)
+#define ERTS_MSACC_SET_STATE_M_X(state) ERTS_MSACC_SET_STATE_M(state)
+#define ERTS_MSACC_SET_STATE_CACHED_X(state) ERTS_MSACC_SET_STATE_CACHED(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state) ERTS_MSACC_PUSH_AND_SET_STATE(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state)
+#define ERTS_MSACC_UPDATE_CACHE_X() ERTS_MSACC_UPDATE_CACHE()
+#define ERTS_MSACC_IS_ENABLED_CACHED_X() ERTS_MSACC_IS_ENABLED_CACHED()
+#define ERTS_MSACC_DECLARE_CACHE_X() ERTS_MSACC_DECLARE_CACHE()
+#define ERTS_MSACC_PUSH_STATE_M_X() ERTS_MSACC_PUSH_STATE_M()
+#define ERTS_MSACC_PUSH_STATE_CACHED_M_X() ERTS_MSACC_PUSH_STATE_CACHED_M()
+#define ERTS_MSACC_SET_STATE_CACHED_M_X(state) ERTS_MSACC_SET_STATE_CACHED_M(state)
+#define ERTS_MSACC_POP_STATE_M_X() ERTS_MSACC_POP_STATE_M()
+#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_M(state)
+
+#endif /* !ERTS_MSACC_EXTENDED_STATES */
+
+#endif /* ERL_MSACC_H__ */
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 3141b05e2b..2204231748 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -314,6 +314,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ErtsProcLocks rp_locks = 0;
Process* rp;
Process* c_p;
+ ErtsMessage *mp;
ErlHeapFragment* frags;
Eterm receiver = to_pid->pid;
int flush_me = 0;
@@ -347,7 +348,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ASSERT(frags == MBUF(&menv->phony_proc));
if (frags != NULL) {
/* Move all offheap's from phony proc to the first fragment.
- Quick and dirty, but erts_move_msg_mbuf_to_heap doesn't care. */
+ Quick and dirty... */
ASSERT(!is_offheap(&frags->off_heap));
frags->off_heap = MSO(&menv->phony_proc);
clear_offheap(&MSO(&menv->phony_proc));
@@ -359,7 +360,9 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
if (flush_me) {
flush_env(env); /* Needed for ERTS_HOLE_CHECK */
}
- erts_queue_message(rp, &rp_locks, frags, msg, am_undefined);
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = frags;
+ erts_queue_message(rp, &rp_locks, mp, msg, am_undefined);
if (c_p == rp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks)
@@ -376,9 +379,19 @@ ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term)
{
Uint sz;
Eterm* hp;
+#ifdef SHCOPY
+ erts_shcopy_t info;
+ INITIALIZE_SHCOPY(info);
+ sz = copy_shared_calculate(src_term, &info);
+ hp = alloc_heap(dst_env, sz);
+ src_term = copy_shared_perform(src_term, sz, &info, &hp, &MSO(dst_env->proc));
+ DESTROY_SHCOPY(info);
+ return src_term;
+#else
sz = size_object(src_term);
hp = alloc_heap(dst_env, sz);
return copy_struct(src_term, sz, &hp, &MSO(dst_env->proc));
+#endif
}
@@ -898,8 +911,13 @@ int enif_get_list_cell(ErlNifEnv* env, Eterm term, Eterm* head, Eterm* tail)
int enif_get_list_length(ErlNifEnv* env, Eterm term, unsigned* len)
{
- if (is_not_list(term) && is_not_nil(term)) return 0;
- *len = erts_list_length(term);
+ Sint i;
+ Uint u;
+
+ if ((i = erts_list_length(term)) < 0) return 0;
+ u = (Uint)i;
+ if ((unsigned)u != u) return 0;
+ *len = u;
return 1;
}
@@ -1792,12 +1810,10 @@ execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc);
ASSERT(ep);
ep->fp = NULL;
+ erts_smp_atomic32_read_band_mb(&proc->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
+ | ERTS_PSFLG_DIRTY_IO_PROC));
result = (*fp)(env, argc, argv);
- erts_smp_atomic32_read_band_mb(&proc->state,
- ~(ERTS_PSFLG_DIRTY_CPU_PROC
- |ERTS_PSFLG_DIRTY_IO_PROC
- |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q
- |ERTS_PSFLG_DIRTY_IO_PROC_IN_Q));
+
if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 && env->mod_nif->mod == NULL)
close_lib(env->mod_nif);
/*
@@ -1845,13 +1861,6 @@ schedule_dirty_nif(ErlNifEnv* env, int flags, int argc, const ERL_NIF_TERM argv[
a = erts_smp_atomic32_read_acqb(&proc->state);
while (1) {
n = state = a;
- /*
- * clear any current dirty flags and dirty queue indicators,
- * in case the application is shifting a job from one type
- * of dirty scheduler to the other
- */
- n &= ~(ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC
- |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q);
if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND)
n |= ERTS_PSFLG_DIRTY_CPU_PROC;
else
@@ -2251,17 +2260,17 @@ int enif_map_iterator_get_pair(ErlNifEnv *env,
***************************************************************************/
-static BeamInstr** get_func_pp(BeamInstr* mod_code, Eterm f_atom, unsigned arity)
+static BeamInstr** get_func_pp(BeamCodeHeader* mod_code, Eterm f_atom, unsigned arity)
{
- int n = (int) mod_code[MI_NUM_FUNCTIONS];
+ int n = (int) mod_code->num_functions;
int j;
for (j = 0; j < n; ++j) {
- BeamInstr* code_ptr = (BeamInstr*) mod_code[MI_FUNCTIONS+j];
+ BeamInstr* code_ptr = (BeamInstr*) mod_code->functions[j];
ASSERT(code_ptr[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
if (f_atom == ((Eterm) code_ptr[3])
&& arity == ((unsigned) code_ptr[4])) {
- return (BeamInstr**) &mod_code[MI_FUNCTIONS+j];
+ return (BeamInstr**) &mod_code->functions[j];
}
}
return NULL;
@@ -2444,8 +2453,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
if (init_func != NULL)
handle = init_func;
- if (!in_area(caller, mod->curr.code, mod->curr.code_length)) {
- ASSERT(in_area(caller, mod->old.code, mod->old.code_length));
+ if (!in_area(caller, mod->curr.code_hdr, mod->curr.code_length)) {
+ ASSERT(in_area(caller, mod->old.code_hdr, mod->old.code_length));
ret = load_nif_error(BIF_P, "old_code", "Calling load_nif from old "
"module '%T' not allowed", mod_atom);
@@ -2499,7 +2508,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) {
BeamInstr** code_pp;
if (!erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1)
- || (code_pp = get_func_pp(mod->curr.code, f_atom, f->arity))==NULL) {
+ || (code_pp = get_func_pp(mod->curr.code_hdr, f_atom, f->arity))==NULL) {
ret = load_nif_error(BIF_P,bad_lib,"Function not found %T:%s/%u",
mod_atom, f->name, f->arity);
}
@@ -2642,7 +2651,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
{
BeamInstr* code_ptr;
erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1);
- code_ptr = *get_func_pp(mod->curr.code, f_atom, f->arity);
+ code_ptr = *get_func_pp(mod->curr.code_hdr, f_atom, f->arity);
if (code_ptr[1] == 0) {
code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif);
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index 75070ad901..c9c8b1d0af 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -77,13 +77,8 @@ 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"
typedef ErlNifUInt ERL_NIF_TERM;
-#endif
typedef ERL_NIF_TERM ERL_NIF_UINT;
@@ -226,22 +221,28 @@ extern TWinDynNifCallbacks WinDynNifCallbacks;
#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
# define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks;
-# ifdef STATIC_ERLANG_NIF
-# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* MODNAME ## _nif_init(TWinDynNifCallbacks* callbacks)
-# else
-# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks)
-# endif
+# define ERL_NIF_INIT_ARGS TWinDynNifCallbacks* callbacks
# define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks))
+# define ERL_NIF_INIT_EXPORT __declspec(dllexport)
#else
# define ERL_NIF_INIT_GLOB
+# define ERL_NIF_INIT_ARGS void
# define ERL_NIF_INIT_BODY
-# ifdef STATIC_ERLANG_NIF
-# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _nif_init(void)
+# if defined(__GNUC__) && __GNUC__ >= 4
+# define ERL_NIF_INIT_EXPORT __attribute__ ((visibility("default")))
+# elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550)
+# define ERL_NIF_INIT_EXPORT __global
# else
-# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void)
+# define ERL_NIF_INIT_EXPORT
# endif
#endif
+#ifdef STATIC_ERLANG_NIF
+# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _nif_init(ERL_NIF_INIT_ARGS)
+#else
+# define ERL_NIF_INIT_DECL(MODNAME) ERL_NIF_INIT_EXPORT ErlNifEntry* nif_init(ERL_NIF_INIT_ARGS)
+#endif
+
#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
# define ERL_NIF_ENTRY_OPTIONS ERL_NIF_DIRTY_NIF_OPTION
#else
diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h
index 211b1a0090..b6a3531e28 100644
--- a/erts/emulator/beam/erl_node_container_utils.h
+++ b/erts/emulator/beam/erl_node_container_utils.h
@@ -255,7 +255,7 @@ extern ErtsPTab erts_port;
* Refs *
\* */
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define internal_ref_no_of_numbers(x) \
(internal_ref_data((x))[0])
@@ -328,8 +328,6 @@ extern ErtsPTab erts_port;
: external_ref_channel_no((x)))
#define is_ref(x) (is_internal_ref((x)) \
|| is_external_ref((x)))
-#define is_ref_rel(x,Base) (is_internal_ref_rel((x),Base) \
- || is_external_ref_rel((x),Base))
#define is_not_ref(x) (!is_ref(x))
#endif
diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c
index 707de39556..13f14adbab 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -787,10 +787,13 @@ void erts_init_node_tables(int dd_sec)
erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table");
erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table");
- f.hash = (H_FUN) dist_table_hash;
- f.cmp = (HCMP_FUN) dist_table_cmp;
- f.alloc = (HALLOC_FUN) dist_table_alloc;
- f.free = (HFREE_FUN) dist_table_free;
+ f.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;
@@ -1157,23 +1160,11 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
break;
}
if (insert_bin) {
-#if HALFWORD_HEAP
- UWord val = (UWord) u.pb->val;
- DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE*2); /* extra place allocated */
-#else
DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE);
-#endif
Uint *hp = &id_heap[0];
InsertedBin *nib;
-#if HALFWORD_HEAP
- int actual_need = BIG_UWORD_HEAP_SIZE(val);
- ASSERT(actual_need <= (BIG_UINT_HEAP_SIZE*2));
- UseTmpHeapNoproc(actual_need);
- a.id = erts_bld_uword(&hp, NULL, (UWord) val);
-#else
UseTmpHeapNoproc(BIG_UINT_HEAP_SIZE);
a.id = erts_bld_uint(&hp, NULL, (Uint) u.pb->val);
-#endif
erts_match_prog_foreach_offheap(u.pb->val,
insert_offheap2,
(void *) &a);
@@ -1181,11 +1172,7 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
nib->bin_val = u.pb->val;
nib->next = inserted_bins;
inserted_bins = nib;
-#if HALFWORD_HEAP
- UnUseTmpHeapNoproc(actual_need);
-#else
UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE);
-#endif
}
}
break;
@@ -1371,56 +1358,50 @@ 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);
diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h
index 694ac84232..fb2f2a5407 100644
--- a/erts/emulator/beam/erl_node_tables.h
+++ b/erts/emulator/beam/erl_node_tables.h
@@ -41,6 +41,7 @@
#include "sys.h"
#include "hash.h"
+#include "erl_alloc.h"
#include "erl_process.h"
#include "erl_monitors.h"
#include "erl_smp.h"
@@ -66,7 +67,7 @@
#define ERTS_DE_QFLGS_ALL (ERTS_DE_QFLG_BUSY \
| ERTS_DE_QFLG_EXIT)
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713f713f713UL)
#else
#define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713)
diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h
index acd68ef0ad..fa97707a87 100644
--- a/erts/emulator/beam/erl_port.h
+++ b/erts/emulator/beam/erl_port.h
@@ -187,6 +187,11 @@ struct _erl_drv_port {
ErtsPrtSD *psd; /* Port specific data */
int reds; /* Only used while executing driver callbacks */
+
+ struct {
+ Eterm to;
+ Uint32 ref[ERTS_MAX_REF_NUMBERS];
+ } *async_open_port; /* Reference used with async open port */
};
@@ -687,7 +692,7 @@ erts_drvport2port_state(ErlDrvPort drvport, erts_aint32_t *statep)
Port *prt = ERTS_ErlDrvPort2Port(drvport);
erts_aint32_t state;
ASSERT(prt);
- ERTS_LC_ASSERT(erts_lc_is_emu_thr());
+// ERTS_LC_ASSERT(erts_lc_is_emu_thr());
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return ERTS_INVALID_ERL_DRV_PORT;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)
@@ -944,4 +949,9 @@ ErtsPortOpResult erts_port_control(Process *, Port *, unsigned int, Eterm, Eterm
ErtsPortOpResult erts_port_call(Process *, Port *, unsigned int, Eterm, Eterm *);
ErtsPortOpResult erts_port_info(Process *, Port *, Eterm, Eterm *);
+/*
+ * Signals from ports to ports. Used by sys drivers.
+ */
+int erl_drv_port_control(Eterm, char, char*, ErlDrvSizeT);
+
#endif
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index 5c38db1cbc..197b328fe2 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -1648,6 +1648,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
int active;
Uint64 start_time = 0;
ErtsSchedulerData *esdp = runq->scheduler;
+ ERTS_MSACC_PUSH_STATE_M();
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
@@ -1690,6 +1691,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
state = erts_atomic32_read_nob(&pp->state);
pp->reds = ERTS_PORT_REDS_EXECUTE;
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
goto begin_handle_tasks;
while (1) {
@@ -1734,7 +1736,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
reds = ERTS_PORT_REDS_INPUT;
ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
DTRACE_DRIVER(driver_ready_input, pp);
- /* NOTE some windows/ose drivers use ->ready_input
+ /* NOTE some windows drivers use ->ready_input
for input and output */
(*pp->drv_ptr->ready_input)((ErlDrvData) pp->drv_data,
ptp->u.alive.td.io.event);
@@ -1822,6 +1824,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
}
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
if (io_tasks_executed) {
diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c
index 2917d58932..45ba4371dc 100644
--- a/erts/emulator/beam/erl_printf_term.c
+++ b/erts/emulator/beam/erl_printf_term.c
@@ -117,13 +117,12 @@ do { \
/* return 0 if list is not a non-empty flat list of printable characters */
static int
-is_printable_string(Eterm list, Eterm* base)
-{
+is_printable_string(Eterm list) {
int len = 0;
int c;
while(is_list(list)) {
- Eterm* consp = list_val_rel(list, base);
+ Eterm* consp = list_val(list);
Eterm hd = CAR(consp);
if (!is_byte(hd))
@@ -260,9 +259,7 @@ static char *format_binary(Uint16 x, char *b) {
#endif
static int
-print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
- Eterm* obj_base) /* ignored if !HALFWORD_HEAP */
-{
+print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) {
DECLARE_WSTACK(s);
int res;
int i;
@@ -308,7 +305,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
obj = (Eterm) popped.word;
L_print_one_cons:
{
- Eterm* cons = list_val_rel(obj, obj_base);
+ Eterm* cons = list_val(obj);
Eterm tl;
obj = CAR(cons);
@@ -344,11 +341,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
PRINT_CHAR(res, fn, arg, '>');
goto L_done;
}
-#if HALFWORD_HEAP
- wobj = is_immed(obj) ? (Wterm)obj : rterm2wterm(obj, obj_base);
-#else
wobj = (Wterm)obj;
-#endif
switch (tag_val_def(wobj)) {
case NIL_DEF:
PRINT_STRING(res, fn, arg, "[]");
@@ -424,10 +417,10 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
PRINT_CHAR(res, fn, arg, '>');
break;
case LIST_DEF:
- if (is_printable_string(obj, obj_base)) {
+ if (is_printable_string(obj)) {
int c;
PRINT_CHAR(res, fn, arg, '"');
- nobj = list_val_rel(obj, obj_base);
+ nobj = list_val(obj);
while (1) {
if ((*dcount)-- <= 0)
goto L_done;
@@ -441,7 +434,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
}
if (is_not_list(*nobj))
break;
- nobj = list_val_rel(*nobj, obj_base);
+ nobj = list_val(*nobj);
}
PRINT_CHAR(res, fn, arg, '"');
} else {
@@ -469,11 +462,11 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
case BINARY_DEF:
{
byte* bytep;
- Uint bytesize = binary_size_rel(obj,obj_base);
+ Uint bytesize = binary_size(obj);
Uint bitoffs;
Uint bitsize;
byte octet;
- ERTS_GET_BINARY_BYTES_REL(obj, bytep, bitoffs, bitsize, obj_base);
+ ERTS_GET_BINARY_BYTES(obj, bytep, bitoffs, bitsize);
if (bitsize || !bytesize
|| !is_printable_ascii(bytep, bytesize, bitoffs)) {
@@ -648,13 +641,11 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
int
-erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision,
- ErlPfEterm* term_base)
-{
+erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision) {
int res;
ERTS_CT_ASSERT(sizeof(ErlPfEterm) == sizeof(Eterm));
- res = print_term(fn, arg, (Eterm)term, &precision, (Eterm*)term_base);
+ res = print_term(fn, arg, (Eterm)term, &precision);
if (res < 0)
return res;
if (precision <= 0)
diff --git a/erts/emulator/beam/erl_printf_term.h b/erts/emulator/beam/erl_printf_term.h
index 87618a36d7..4618457f27 100644
--- a/erts/emulator/beam/erl_printf_term.h
+++ b/erts/emulator/beam/erl_printf_term.h
@@ -22,6 +22,5 @@
#define ERL_PRINTF_TERM_H__
#include "erl_printf_format.h"
-int erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision,
- ErlPfEterm* term_base);
+int erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision);
#endif
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 99a4011b8f..e4584e7cc2 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -58,11 +58,7 @@
#define ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST (CONTEXT_REDS/10)
-#ifndef ERTS_SCHED_MIN_SPIN
#define ERTS_SCHED_SPIN_UNTIL_YIELD 100
-#else
-#define ERTS_SCHED_SPIN_UNTIL_YIELD 1
-#endif
#define ERTS_SCHED_SYS_SLEEP_SPINCOUNT_VERY_LONG 40
#define ERTS_SCHED_AUX_WORK_SLEEP_SPINCOUNT_FACT_VERY_LONG 1000
@@ -119,7 +115,7 @@
#define RUNQ_SET_RQ(X, RQ) erts_smp_atomic_set_nob((X), (erts_aint_t) (RQ))
#ifdef DEBUG
-# if defined(ARCH_64) && !HALFWORD_HEAP
+# if defined(ARCH_64)
# define ERTS_DBG_SET_INVALID_RUNQP(RQP, N) \
(RUNQ_SET_RQ((RQP), (0xdeadbeefdead0003LL | ((N) << 4)))
# define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) \
@@ -152,18 +148,14 @@ extern BeamInstr beam_apply[];
extern BeamInstr beam_exit[];
extern BeamInstr beam_continue_exit[];
-#ifdef __OSE__
-/* Eager check I/O not supported on OSE yet. */
-int erts_eager_check_io = 0;
-#else
-int erts_eager_check_io = 1;
-#endif
-int erts_sched_compact_load;
-int erts_sched_balance_util = 0;
-Uint erts_no_schedulers;
+int ERTS_WRITE_UNLIKELY(erts_default_spo_flags) = 0;
+int ERTS_WRITE_UNLIKELY(erts_eager_check_io) = 1;
+int ERTS_WRITE_UNLIKELY(erts_sched_compact_load);
+int ERTS_WRITE_UNLIKELY(erts_sched_balance_util) = 0;
+Uint ERTS_WRITE_UNLIKELY(erts_no_schedulers);
#ifdef ERTS_DIRTY_SCHEDULERS
-Uint erts_no_dirty_cpu_schedulers;
-Uint erts_no_dirty_io_schedulers;
+Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_cpu_schedulers);
+Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_io_schedulers);
#endif
static char *erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_NO_FLAGS] = {0};
@@ -303,7 +295,7 @@ do { \
erts_sched_stat_t erts_sched_stat;
#ifdef USE_THREADS
-static erts_tsd_key_t sched_data_key;
+static erts_tsd_key_t ERTS_WRITE_UNLIKELY(sched_data_key);
#endif
static erts_smp_atomic32_t function_calls;
@@ -343,11 +335,10 @@ 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 */
@@ -361,7 +352,8 @@ int erts_system_profile_ts_type = ERTS_TRACE_FLG_NOW_TIMESTAMP;
typedef enum {
ERTS_PSTT_GC, /* Garbage Collect */
- ERTS_PSTT_CPC /* Check Process Code */
+ ERTS_PSTT_CPC, /* Check Process Code */
+ ERTS_PSTT_COHMQ /* Change off heap message queue */
} ErtsProcSysTaskType;
#define ERTS_MAX_PROC_SYS_TASK_ARGS 2
@@ -507,9 +499,6 @@ dbg_chk_aux_work_val(erts_aint32_t value)
#if HAVE_ERTS_MSEG
valid |= ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK;
#endif
-#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
- valid |= ERTS_SSI_AUX_WORK_CHECK_CHILDREN;
-#endif
#ifdef ERTS_SSI_AUX_WORK_REAP_PORTS
valid |= ERTS_SSI_AUX_WORK_REAP_PORTS;
#endif
@@ -596,8 +585,6 @@ erts_pre_init_process(void)
= "MISC_THR_PRGR";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MISC_IX]
= "MISC";
- erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX]
- = "CHECK_CHILDREN";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_SET_TMO_IX]
= "SET_TMO";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX]
@@ -685,7 +672,6 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab)
last_reductions = 0;
last_exact_reductions = 0;
- erts_default_process_flags = 0;
}
void
@@ -955,6 +941,12 @@ sched_wall_time_change(ErtsSchedulerData *esdp, int working)
}
}
}
+ if (!working) {
+ ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_BUSY_WAIT);
+ } else {
+ ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_OTHER);
+ }
+
}
typedef struct {
@@ -976,7 +968,6 @@ typedef struct {
} ErtsSystemCheckReq;
-#if !HALFWORD_HEAP
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(swtreq,
ErtsSchedWallTimeReq,
5,
@@ -986,33 +977,6 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(screq,
ErtsSystemCheckReq,
5,
ERTS_ALC_T_SYS_CHECK_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);
-}
-
-static ERTS_INLINE ErtsSystemCheckReq *
-screq_alloc(void)
-{
- return erts_alloc(ERTS_ALC_T_SYS_CHECK_REQ,
- sizeof(ErtsSystemCheckReq));
-}
-
-static ERTS_INLINE void
-screq_free(ErtsSystemCheckReq *ptr)
-{
- erts_free(ERTS_ALC_T_SYS_CHECK_REQ, ptr);
-}
-#endif
static void
reply_sched_wall_time(void *vswtrp)
@@ -1029,7 +993,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
@@ -1085,12 +1049,12 @@ reply_sched_wall_time(void *vswtrp)
if (hpp)
break;
- hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
szp = NULL;
hpp = &hp;
}
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (swtrp->req_sched == esdp->no)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -1157,7 +1121,7 @@ reply_system_check(void *vscrp)
Eterm **hpp;
Uint sz;
ErlOffHeap *ohp = NULL;
- ErlHeapFragment *bp = NULL;
+ ErtsMessage *mp = NULL;
ASSERT(esdp);
#ifdef ERTS_DIRTY_SCHEDULERS
@@ -1165,11 +1129,11 @@ reply_system_check(void *vscrp)
#endif
sz = REF_THING_SIZE;
- hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
+ 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, bp, msg, NIL);
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (scrp->req_sched == esdp->no)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -1821,15 +1785,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) {
@@ -2216,34 +2182,6 @@ erts_debug_wait_completed(Process *c_p, int flags)
}
-#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
-void
-erts_smp_notify_check_children_needed(void)
-{
- int i;
- for (i = 0; i < erts_no_schedulers; i++)
- set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(i),
- ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
-#ifdef ERTS_DIRTY_SCHEDULERS
- for (i = 0; i < erts_no_dirty_cpu_schedulers; i++)
- set_aux_work_flags_wakeup_nob(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(i),
- ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
- for (i = 0; i < erts_no_dirty_io_schedulers; i++)
- set_aux_work_flags_wakeup_nob(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(i),
- ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
-#endif
-}
-
-static ERTS_INLINE erts_aint32_t
-handle_check_children(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
-{
- unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
- erts_check_children();
- return aux_work & ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN;
-}
-
-#endif
-
static void
notify_reap_ports_relb(void)
{
@@ -2329,12 +2267,15 @@ 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
@@ -2398,10 +2339,6 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_MISC,
handle_misc_aux_work);
-#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
- HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CHECK_CHILDREN,
- handle_check_children);
-#endif
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_SET_TMO,
handle_setup_aux_work_timer);
@@ -2429,6 +2366,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
@@ -2629,19 +2568,10 @@ try_set_sys_scheduling(void)
#endif
static ERTS_INLINE int
-prepare_for_sys_schedule(ErtsSchedulerData *esdp, int non_blocking)
+prepare_for_sys_schedule(int non_blocking)
{
if (non_blocking && erts_eager_check_io) {
#ifdef ERTS_SMP
-#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1
- if (esdp->no != 1) {
- /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used
- then we make sure to wake scheduler 1 */
- ErtsRunQueue *rq = ERTS_RUNQ_IX(0);
- wake_scheduler(rq);
- return 0;
- }
-#endif
return try_set_sys_scheduling();
#else
return 1;
@@ -2651,16 +2581,6 @@ prepare_for_sys_schedule(ErtsSchedulerData *esdp, int non_blocking)
#ifdef ERTS_SMP
while (!erts_port_task_have_outstanding_io_tasks()
&& try_set_sys_scheduling()) {
-#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1
- if (esdp->no != 1) {
- /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used
- then we make sure to wake scheduler 1 */
- ErtsRunQueue *rq = ERTS_RUNQ_IX(0);
- clear_sys_scheduling();
- wake_scheduler(rq);
- return 0;
- }
-#endif
if (!erts_port_task_have_outstanding_io_tasks())
return 1;
clear_sys_scheduling();
@@ -2955,6 +2875,8 @@ aux_thread(void *unused)
ssi->event = erts_tse_fetch();
+ erts_msacc_init_thread("aux", 1, 1);
+
callbacks.arg = (void *) ssi;
callbacks.wakeup = thr_prgr_wakeup;
callbacks.prepare_wait = thr_prgr_prep_wait;
@@ -2965,6 +2887,7 @@ aux_thread(void *unused)
init_aux_work_data(awdp, NULL, NULL);
awdp->ssi = ssi;
+
sched_prep_spin_wait(ssi);
while (1) {
@@ -2984,8 +2907,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) {
@@ -3020,6 +2941,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));
@@ -3053,7 +2977,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
* be waiting in erl_sys_schedule()
*/
- if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(esdp, 0)) {
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(0)) {
sched_waiting(esdp->no, rq);
@@ -3067,7 +2991,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
sched_wall_time_change(esdp, thr_prgr_active);
while (1) {
- ErtsMonotonicTime current_time;
+ ErtsMonotonicTime current_time = 0;
aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
@@ -3076,6 +3000,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
sched_wall_time_change(esdp, 1);
}
aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1);
+ ERTS_MSACC_UPDATE_CACHE();
if (aux_work && erts_thr_progress_update(esdp))
erts_thr_progress_leader_update(esdp);
}
@@ -3117,8 +3042,6 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
erts_thr_progress_prepare_wait(esdp);
}
- ERTS_SCHED_FAIR_YIELD();
-
flgs = sched_spin_wait(ssi, spincount);
if (flgs & ERTS_SSI_FLG_SLEEPING) {
ASSERT(flgs & ERTS_SSI_FLG_WAITING);
@@ -3139,7 +3062,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
- 1) + 1;
} else
timeout = -1;
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
res = erts_tse_twait(ssi->event, timeout);
+ ERTS_MSACC_POP_STATE_M();
current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
erts_get_monotonic_time(esdp);
} while (res == EINTR);
@@ -3189,13 +3114,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);
@@ -3213,9 +3133,13 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
if (working)
sched_wall_time_change(esdp, working = 0);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
+
ASSERT(!erts_port_task_have_outstanding_io_tasks());
erl_sys_schedule(1); /* Might give us something to do */
+ ERTS_MSACC_POP_STATE_M();
+
if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
current_time = erts_get_monotonic_time(esdp);
if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
@@ -3236,6 +3160,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);
@@ -3262,7 +3187,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
* Got to check that we still got I/O tasks; otherwise
* we have to continue checking for I/O...
*/
- if (!prepare_for_sys_schedule(esdp, 0)) {
+ if (!prepare_for_sys_schedule(0)) {
spincount *= ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT;
goto tse_wait;
}
@@ -3284,7 +3209,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
* Got to check that we still got I/O tasks; otherwise
* we have to wait in erl_sys_schedule() after all...
*/
- if (!prepare_for_sys_schedule(esdp, 0)) {
+ if (!prepare_for_sys_schedule(0)) {
/*
* Not allowed to wait in erl_sys_schedule;
* do tse wait instead...
@@ -3333,8 +3258,12 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
ASSERT(!erts_port_task_have_outstanding_io_tasks());
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
+
erl_sys_schedule(0);
+ ERTS_MSACC_POP_STATE_M();
+
if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
ErtsMonotonicTime current_time = erts_get_monotonic_time(esdp);
if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
@@ -3729,6 +3658,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 *
@@ -4043,9 +3979,6 @@ evacuate_run_queue(ErtsRunQueue *rq,
erts_aint32_t state;
Process *proc;
int notify = 0;
-#ifdef ERTS_DIRTY_SCHEDULERS
- int requeue;
-#endif
to_rq = NULL;
#ifdef ERTS_DIRTY_SCHEDULERS
@@ -4060,49 +3993,94 @@ evacuate_run_queue(ErtsRunQueue *rq,
proc = dequeue_process(rq, prio_q, &state);
while (proc) {
-#ifdef ERTS_DIRTY_SCHEDULERS
- requeue = 1;
+ Process *real_proc;
+ int prio;
+ erts_aint32_t max_qbit, qbit, real_state;
+
+ prio = ERTS_PSFLGS_GET_PRQ_PRIO(state);
+ qbit = ((erts_aint32_t) 1) << prio;
+
+ if (!(state & ERTS_PSFLG_PROXY)) {
+ real_proc = proc;
+ real_state = state;
+ }
+ else {
+ real_proc = erts_proc_lookup_raw(proc->common.id);
+ if (!real_proc) {
+ free_proxy_proc(proc);
+ goto handle_next_proc;
+ }
+ real_state = erts_smp_atomic32_read_acqb(&real_proc->state);
+ }
+
+ max_qbit = (state >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET);
+ max_qbit &= ERTS_PSFLGS_QMASK;
+ max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS;
+ max_qbit &= -max_qbit;
+
+ if (qbit > max_qbit) {
+ /* Process already queued with higher prio; drop it... */
+ if (real_proc != proc)
+ free_proxy_proc(proc);
+ else {
+ erts_aint32_t clr_bits;
+#ifdef DEBUG
+ erts_aint32_t old;
#endif
- if (ERTS_PSFLG_BOUND & state) {
- /* Bound processes get stuck here... */
- proc->next = NULL;
- if (sbpp->last)
- sbpp->last->next = proc;
- else
- sbpp->first = proc;
- sbpp->last = proc;
-#ifdef ERTS_DIRTY_SCHEDULERS
- requeue = 0;
+
+ clr_bits = ERTS_PSFLG_IN_RUNQ;
+ clr_bits |= qbit << ERTS_PSFLGS_IN_PRQ_MASK_OFFSET;
+
+#ifdef DEBUG
+ old =
+#else
+ (void)
#endif
+ erts_smp_atomic32_read_band_mb(&proc->state,
+ ~clr_bits);
+ ASSERT((old & clr_bits) == clr_bits);
+
+ }
+
+ goto handle_next_proc;
}
+
#ifdef ERTS_DIRTY_SCHEDULERS
- else if (state & ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q) {
+
+ if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) {
+ erts_aint32_t dqbit = qbit;
#ifdef DEBUG
- erts_aint32_t old =
-#else
- (void)
+ erts_aint32_t old_dqbit;
#endif
- erts_smp_atomic32_read_band_nob(&proc->state,
- ~(ERTS_PSFLG_DIRTY_CPU_PROC
- | ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q));
- /* assert that no other dirty flags are set */
- ASSERT(!(old & (ERTS_PSFLG_DIRTY_IO_PROC|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)));
- } else if (state & ERTS_PSFLG_DIRTY_IO_PROC_IN_Q) {
+
+ if (rq == ERTS_DIRTY_CPU_RUNQ)
+ dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET;
+ else {
+ ASSERT(rq == ERTS_DIRTY_IO_RUNQ);
+ dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET;
+ }
+
#ifdef DEBUG
- erts_aint32_t old =
+ old_dqbit = (int)
#else
- (void)
+ (void)
#endif
- erts_smp_atomic32_read_band_nob(&proc->state,
- ~(ERTS_PSFLG_DIRTY_IO_PROC
- | ERTS_PSFLG_DIRTY_IO_PROC_IN_Q));
- /* assert that no other dirty flags are set */
- ASSERT(!(old & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q)));
+ erts_smp_atomic32_read_band_mb(&real_proc->dirty_state,
+ ~dqbit);
+ ASSERT(old_dqbit & dqbit);
}
- if (requeue) {
-#else
- else {
#endif
+
+ if (ERTS_PSFLG_BOUND & real_state) {
+ /* Bound processes get stuck here... */
+ proc->next = NULL;
+ if (sbpp->last)
+ sbpp->last->next = proc;
+ else
+ sbpp->first = proc;
+ sbpp->last = proc;
+ }
+ else {
int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state);
erts_smp_runq_unlock(rq);
@@ -4125,6 +4103,8 @@ evacuate_run_queue(ErtsRunQueue *rq,
erts_smp_runq_lock(rq);
}
+
+ handle_next_proc:
proc = dequeue_process(rq, prio_q, &state);
}
if (notify)
@@ -5405,17 +5385,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
@@ -5599,9 +5573,6 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num,
esdp->f_reg_array =
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER,
MAX_REG * sizeof(FloatDef));
-#if !HEAP_ON_C_STACK
- esdp->num_tmp_heap_used = 0;
-#endif
#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) {
esdp->no = 0;
@@ -5886,10 +5857,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
#endif
init_misc_aux_work();
-#if !HALFWORD_HEAP
init_swtreq_alloc();
init_screq_alloc();
-#endif
erts_atomic32_init_nob(&debug_wait_completed_count, 0); /* debug only */
debug_wait_completed_flags = 0;
@@ -6069,19 +6038,96 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio)
return proxy;
}
-static ERTS_INLINE void
-free_proxy_proc(Process *proxy)
-{
- ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY);
- erts_free(ERTS_ALC_T_PROC, proxy);
-}
-
#define ERTS_ENQUEUE_NOT 0
#define ERTS_ENQUEUE_NORMAL_QUEUE 1
-#ifdef ERTS_DIRTY_SCHEDULERS
#define ERTS_ENQUEUE_DIRTY_CPU_QUEUE 2
#define ERTS_ENQUEUE_DIRTY_IO_QUEUE 3
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+static int
+check_dirty_enqueue_in_prio_queue(Process *c_p,
+ erts_aint32_t *newp,
+ erts_aint32_t actual,
+ erts_aint32_t aprio,
+ erts_aint32_t qbit)
+{
+ int queue;
+ erts_aint32_t dact, max_qbit;
+
+ /* Termination should be done on an ordinary scheduler */
+ if (actual & ERTS_PSFLG_EXITING) {
+ *newp &= ~ERTS_PSFLGS_DIRTY_WORK;
+ return ERTS_ENQUEUE_NORMAL_QUEUE;
+ }
+
+ /*
+ * If we have system tasks, we enqueue on ordinary run-queue
+ * and take care of those system tasks first.
+ */
+ if (actual & ERTS_PSFLG_ACTIVE_SYS)
+ return ERTS_ENQUEUE_NORMAL_QUEUE;
+
+ dact = erts_smp_atomic32_read_mb(&c_p->dirty_state);
+ if (actual & (ERTS_PSFLG_DIRTY_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_CPU_PROC)) {
+ max_qbit = ((dact >> ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET)
+ & ERTS_PDSFLGS_QMASK);
+ queue = ERTS_ENQUEUE_DIRTY_CPU_QUEUE;
+ }
+ else {
+ ASSERT(actual & ERTS_PSFLG_DIRTY_IO_PROC);
+ max_qbit = ((dact >> ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET)
+ & ERTS_PDSFLGS_QMASK);
+ queue = ERTS_ENQUEUE_DIRTY_IO_QUEUE;
+ }
+
+ max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS;
+ max_qbit &= -max_qbit;
+
+ if (qbit >= max_qbit)
+ return ERTS_ENQUEUE_NOT; /* Already queued in higher or equal prio */
+ if ((actual & (ERTS_PSFLG_IN_RUNQ|ERTS_PSFLGS_USR_PRIO_MASK))
+ != (aprio << ERTS_PSFLGS_USR_PRIO_OFFSET)) {
+ /*
+ * Process struct already enqueued, or actual prio not
+ * equal to user prio, i.e., enqueue using proxy.
+ */
+ return -1*queue;
+ }
+
+ *newp |= ERTS_PSFLG_IN_RUNQ;
+ return queue;
+}
+
+static ERTS_INLINE int
+fin_dirty_enq_s_change(Process *p,
+ int pstruct_reserved,
+ erts_aint32_t enq_prio,
+ int qmask_offset)
+{
+ erts_aint32_t qbit = 1 << enq_prio;
+ qbit <<= qmask_offset;
+
+ if (qbit & erts_smp_atomic32_read_bor_mb(&p->dirty_state, qbit)) {
+ /* Already enqueue by someone else... */
+ if (pstruct_reserved) {
+ /* We reserved process struct for enqueue; clear it... */
+#ifdef DEBUG
+ erts_aint32_t old =
+#else
+ (void)
#endif
+ erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_IN_RUNQ);
+ ASSERT(old & ERTS_PSFLG_IN_RUNQ);
+ }
+ return 0;
+ }
+
+ return !0;
+}
+
+#endif /* ERTS_DIRTY_SCHEDULERS */
static ERTS_INLINE int
check_enqueue_in_prio_queue(Process *c_p,
@@ -6097,61 +6143,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;
@@ -6183,6 +6182,65 @@ check_enqueue_in_prio_queue(Process *c_p,
return ERTS_ENQUEUE_NORMAL_QUEUE;
}
+static ERTS_INLINE ErtsRunQueue *
+select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t state)
+{
+
+ switch (enqueue) {
+
+ case ERTS_ENQUEUE_NOT:
+
+ return NULL;
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+ case ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
+ case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
+
+ if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio,
+ ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET))
+ return ERTS_DIRTY_CPU_RUNQ;
+
+ return NULL;
+
+
+ case ERTS_ENQUEUE_DIRTY_IO_QUEUE:
+ case -ERTS_ENQUEUE_DIRTY_IO_QUEUE:
+
+ if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio,
+ ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET))
+ return ERTS_DIRTY_IO_RUNQ;
+
+ return NULL;
+
+#endif
+
+ default: {
+ ErtsRunQueue* runq;
+
+ ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE
+ || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE);
+
+ runq = erts_get_runq_proc(p);
+
+#ifdef ERTS_SMP
+ if (!(ERTS_PSFLG_BOUND & state)) {
+ ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio);
+ if (new_runq) {
+ RUNQ_SET_RQ(&p->run_queue, new_runq);
+ runq = new_runq;
+ }
+ }
+#endif
+
+ ASSERT(runq);
+
+ return runq;
+ }
+ }
+}
+
+
/*
* schedule_out_process() return with c_rq locked.
*/
@@ -6191,11 +6249,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces
{
erts_aint32_t a, e, n, enq_prio = -1;
int enqueue; /* < 0 -> use proxy */
- Process* sched_p;
ErtsRunQueue* runq;
-#ifdef ERTS_SMP
- int check_emigration_need;
-#endif
a = state;
@@ -6207,7 +6261,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces
enqueue = ERTS_ENQUEUE_NOT;
n &= ~(ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS);
- if (a & ERTS_PSFLG_ACTIVE_SYS
+ if (a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS)
|| (a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE) {
enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a);
}
@@ -6216,16 +6270,17 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces
break;
}
- switch (enqueue) {
- case ERTS_ENQUEUE_NOT:
+ runq = select_enqueue_run_queue(enqueue, enq_prio, p, n);
+
+ if (!runq) {
+
if (erts_system_profile_flags.runnable_procs) {
/* Status lock prevents out of order "runnable proc" trace msgs */
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
- if (!(a & ERTS_PSFLG_ACTIVE_SYS)
- && (!(a & ERTS_PSFLG_ACTIVE)
- || (a & ERTS_PSFLG_SUSPENDED))) {
+ if (!(a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS))
+ && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) {
/* Process inactive */
profile_runnable_proc(p, am_inactive);
}
@@ -6238,98 +6293,76 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces
return 0;
-#ifdef ERTS_DIRTY_SCHEDULERS
-#ifdef ERTS_SMP
- case ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
- case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
- runq = ERTS_DIRTY_CPU_RUNQ;
- ASSERT(ERTS_SCHEDULER_IS_DIRTY_CPU(runq->scheduler));
-#ifdef ERTS_SMP
- check_emigration_need = 0;
-#endif
- break;
+ }
+ else {
+ Process* sched_p;
- case ERTS_ENQUEUE_DIRTY_IO_QUEUE:
- case -ERTS_ENQUEUE_DIRTY_IO_QUEUE:
- runq = ERTS_DIRTY_IO_RUNQ;
- ASSERT(ERTS_SCHEDULER_IS_DIRTY_IO(runq->scheduler));
-#ifdef ERTS_SMP
- check_emigration_need = 0;
-#endif
- break;
-#endif
-#endif
+ ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS)));
- default:
- ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE
- || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE);
+ if (enqueue < 0)
+ sched_p = make_proxy_proc(proxy, p, enq_prio);
+ else {
+ sched_p = p;
+ if (proxy)
+ free_proxy_proc(proxy);
+ }
- runq = erts_get_runq_proc(p);
-#ifdef ERTS_SMP
- check_emigration_need = !(ERTS_PSFLG_BOUND & n);
-#endif
- break;
- }
+ ASSERT(runq);
- ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & ERTS_PSFLG_ACTIVE_SYS));
+ erts_smp_runq_lock(runq);
- if (enqueue < 0)
- sched_p = make_proxy_proc(proxy, p, enq_prio);
- else {
- sched_p = p;
- if (proxy)
- free_proxy_proc(proxy);
- }
+ /* Enqueue the process */
+ enqueue_process(runq, (int) enq_prio, sched_p);
-#ifdef ERTS_SMP
- if (check_emigration_need) {
- ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio);
- if (new_runq) {
- RUNQ_SET_RQ(&sched_p->run_queue, new_runq);
- runq = new_runq;
- }
- }
-#endif
+ if (runq == c_rq)
+ return 1;
- ASSERT(runq);
+ erts_smp_runq_unlock(runq);
- erts_smp_runq_lock(runq);
+ smp_notify_inc_runq(runq);
- /* Enqueue the process */
- enqueue_process(runq, (int) enq_prio, sched_p);
+ erts_smp_runq_lock(c_rq);
- if (runq == c_rq)
return 1;
- erts_smp_runq_unlock(runq);
- smp_notify_inc_runq(runq);
- erts_smp_runq_lock(c_rq);
- return 1;
+ }
+
}
static ERTS_INLINE void
-add2runq(Process *p, erts_aint32_t state, erts_aint32_t prio)
+add2runq(int enqueue, erts_aint32_t prio,
+ Process *proc, erts_aint32_t state,
+ Process **proxy)
{
- ErtsRunQueue *runq = erts_get_runq_proc(p);
+ ErtsRunQueue *runq;
-#ifdef ERTS_SMP
- if (!(ERTS_PSFLG_BOUND & state)) {
- ErtsRunQueue *new_runq = erts_check_emigration_need(runq, (int) prio);
- if (new_runq) {
- RUNQ_SET_RQ(&p->run_queue, new_runq);
- runq = new_runq;
- }
- }
-#endif
- ASSERT(runq);
+ runq = select_enqueue_run_queue(enqueue, prio, proc, state);
- erts_smp_runq_lock(runq);
+ if (runq) {
+ Process *sched_p;
- /* Enqueue the process */
- enqueue_process(runq, (int) prio, p);
+ if (enqueue > 0)
+ sched_p = proc;
+ else {
+ Process *pxy;
- erts_smp_runq_unlock(runq);
- smp_notify_inc_runq(runq);
+ if (!proxy)
+ pxy = NULL;
+ else {
+ pxy = *proxy;
+ *proxy = NULL;
+ }
+ sched_p = make_proxy_proc(pxy, proc, prio);
+ }
+
+ erts_smp_runq_lock(runq);
+ /* Enqueue the process */
+ enqueue_process(runq, (int) prio, sched_p);
+
+ erts_smp_runq_unlock(runq);
+ smp_notify_inc_runq(runq);
+ }
}
static ERTS_INLINE int
@@ -6435,10 +6468,7 @@ schedule_process(Process *p, erts_aint32_t in_state, ErtsProcLocks locks)
&state,
&enq_prio,
locks);
- if (enqueue != ERTS_ENQUEUE_NOT)
- add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio),
- state,
- enq_prio);
+ add2runq(enqueue, enq_prio, p, state, NULL);
}
void
@@ -6447,22 +6477,99 @@ erts_schedule_process(Process *p, erts_aint32_t state, ErtsProcLocks locks)
schedule_process(p, state, locks);
}
-static void
-schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy)
+static int
+schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st)
{
- /*
- * Expects status lock to be locked when called, and
- * returns with status lock unlocked...
- */
- erts_aint32_t a = state, n, enq_prio = -1;
+ int res;
+ int locked;
+ ErtsProcSysTaskQs *stqs, *free_stqs;
+ erts_aint32_t state, a, n, enq_prio;
int enqueue; /* < 0 -> use proxy */
- unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs;
+ unsigned int prof_runnable_procs;
+
+ res = 1; /* prepare for success */
+ st->next = st->prev = st; /* Prep for empty prio queue */
+ state = erts_smp_atomic32_read_nob(&p->state);
+ prof_runnable_procs = erts_system_profile_flags.runnable_procs;
+ locked = 0;
+ free_stqs = NULL;
+ if (state & ERTS_PSFLG_ACTIVE_SYS)
+ stqs = NULL;
+ else {
+ alloc_qs:
+ stqs = proc_sys_task_queues_alloc();
+ stqs->qmask = 1 << prio;
+ stqs->ncount = 0;
+ stqs->q[PRIORITY_MAX] = NULL;
+ stqs->q[PRIORITY_HIGH] = NULL;
+ stqs->q[PRIORITY_NORMAL] = NULL;
+ stqs->q[PRIORITY_LOW] = NULL;
+ stqs->q[prio] = st;
+ }
+
+ if (!locked) {
+ locked = 1;
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+
+ state = erts_smp_atomic32_read_nob(&p->state);
+ if (state & ERTS_PSFLG_EXITING) {
+ free_stqs = stqs;
+ res = 0;
+ goto cleanup;
+ }
+ }
+
+ if (!p->sys_task_qs) {
+ if (stqs)
+ p->sys_task_qs = stqs;
+ else
+ goto alloc_qs;
+ }
+ else {
+ free_stqs = stqs;
+ stqs = p->sys_task_qs;
+ if (!stqs->q[prio]) {
+ stqs->q[prio] = st;
+ stqs->qmask |= 1 << prio;
+ }
+ else {
+ st->next = stqs->q[prio];
+ st->prev = stqs->q[prio]->prev;
+ st->next->prev = st;
+ st->prev->next = st;
+ ASSERT(stqs->qmask & (1 << prio));
+ }
+ }
+
+ if (ERTS_PSFLGS_GET_ACT_PRIO(state) > prio) {
+ erts_aint32_t n, a, e;
+ /* Need to elevate actual prio */
+
+ a = state;
+ do {
+ if (ERTS_PSFLGS_GET_ACT_PRIO(a) <= prio) {
+ n = a;
+ break;
+ }
+ n = e = a;
+ n &= ~ERTS_PSFLGS_ACT_PRIO_MASK;
+ n |= (prio << ERTS_PSFLGS_ACT_PRIO_OFFSET);
+ a = erts_smp_atomic32_cmpxchg_nob(&p->state, n, e);
+ } while (a != e);
+ state = n;
+ }
+
+
+ a = state;
+ enq_prio = -1;
/* Status lock prevents out of order "runnable proc" trace msgs */
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
- if (!prof_runnable_procs)
+ if (!prof_runnable_procs) {
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ locked = 0;
+ }
ASSERT(!(state & ERTS_PSFLG_PROXY));
@@ -6470,8 +6577,10 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy)
erts_aint32_t e;
n = e = a;
- if (a & ERTS_PSFLG_FREE)
+ if (a & ERTS_PSFLG_FREE) {
+ res = 0;
goto cleanup; /* We don't want to schedule free processes... */
+ }
enqueue = ERTS_ENQUEUE_NOT;
n |= ERTS_PSFLG_ACTIVE_SYS;
@@ -6495,29 +6604,22 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy)
}
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- prof_runnable_procs = 0;
+ locked = 0;
}
- if (enqueue != ERTS_ENQUEUE_NOT) {
- Process *sched_p;
- if (enqueue > 0)
- sched_p = p;
- else {
- sched_p = make_proxy_proc(proxy, p, enq_prio);
- proxy = NULL;
- }
- add2runq(sched_p, n, enq_prio);
- }
+ add2runq(enqueue, enq_prio, p, n, NULL);
cleanup:
- if (prof_runnable_procs)
+ if (locked)
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- if (proxy)
- free_proxy_proc(proxy);
+ if (free_stqs)
+ proc_sys_task_queues_free(free_stqs);
ERTS_SMP_LC_ASSERT(!(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)));
+
+ return res;
}
static ERTS_INLINE int
@@ -6600,10 +6702,7 @@ resume_process(Process *p, ErtsProcLocks locks)
&state,
&enq_prio,
locks);
- if (enqueue)
- add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio),
- state,
- enq_prio);
+ add2runq(enqueue, enq_prio, p, state, NULL);
}
int
@@ -8046,6 +8145,8 @@ sched_thread_func(void *vesdp)
callbacks.wait = thr_prgr_wait;
callbacks.finalize_wait = thr_prgr_fin_wait;
+ erts_msacc_init_thread("scheduler", no, 1);
+
erts_thr_progress_register_managed_thread(esdp, &callbacks, 0);
erts_alloc_register_scheduler(vesdp);
#endif
@@ -8301,18 +8402,12 @@ erts_start_schedulers(void)
erts_snprintf(opts.name, 16, "%lu_scheduler", actual + 1);
-#ifdef __OSE__
- /* This should be done in the bind strategy */
- opts.coreNo = (actual+1) % ose_num_cpus();
-#endif
-
res = ethr_thr_create(&esdp->tid, sched_thread_func, (void*)esdp, &opts);
if (res != 0) {
break;
}
}
-
erts_no_schedulers = actual;
#ifdef ERTS_DIRTY_SCHEDULERS
@@ -8341,10 +8436,6 @@ erts_start_schedulers(void)
erts_snprintf(opts.name, 16, "aux");
-#ifdef __OSE__
- opts.coreNo = 0;
-#endif /* __OSE__ */
-
res = ethr_thr_create(&aux_tid, aux_thread, NULL, &opts);
if (res != 0)
erl_exit(1, "Failed to create aux thread\n");
@@ -8364,7 +8455,6 @@ erts_start_schedulers(void)
actual, actual == 1 ? " was" : "s were");
erts_send_error_to_logger_nogl(dsbufp);
}
-
}
#endif /* ERTS_SMP */
@@ -8383,7 +8473,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;
@@ -9378,6 +9468,8 @@ Process *schedule(Process *p, int calls)
Uint32 flags;
erts_aint32_t state = 0; /* Supress warning... */
+ ERTS_MSACC_DECLARE_CACHE();
+
#ifdef USE_VM_PROBES
if (p != NULL && DTRACE_ENABLED(process_unscheduled)) {
DTRACE_CHARBUF(process_buf, DTRACE_TERM_BUF_SIZE);
@@ -9412,6 +9504,8 @@ Process *schedule(Process *p, int calls)
} else {
sched_out_proc:
+ ASSERT(!(p->flags & F_DELAY_GC));
+
#ifdef ERTS_SMP
ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
esdp = p->scheduler_data;
@@ -9480,6 +9574,8 @@ Process *schedule(Process *p, int calls)
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER);
+
if (state & ERTS_PSFLG_FREE) {
#ifdef ERTS_SMP
ASSERT(esdp->free_process == p);
@@ -9516,15 +9612,16 @@ Process *schedule(Process *p, int calls)
#ifdef ERTS_SMP
ErtsMigrationPaths *mps;
ErtsMigrationPath *mp;
- ErtsProcList *pnd_xtrs = rq->procs.pending_exiters;
- if (erts_proclist_fetch(&pnd_xtrs, NULL)) {
+
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ ErtsProcList *pnd_xtrs = rq->procs.pending_exiters;
+ if (erts_proclist_fetch(&pnd_xtrs, NULL)) {
rq->procs.pending_exiters = NULL;
erts_smp_runq_unlock(rq);
handle_pending_exiters(pnd_xtrs);
erts_smp_runq_lock(rq);
}
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
if (rq->check_balance_reds <= 0)
check_balance(rq);
@@ -9568,12 +9665,10 @@ Process *schedule(Process *p, int calls)
erts_aint32_t aux_work;
int leader_update = erts_thr_progress_update(esdp);
aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work);
- if (aux_work | leader_update | ERTS_SCHED_FAIR) {
+ if (aux_work | leader_update) {
erts_smp_runq_unlock(rq);
if (leader_update)
erts_thr_progress_leader_update(esdp);
- else if (ERTS_SCHED_FAIR)
- ERTS_SCHED_FAIR_YIELD();
if (aux_work)
handle_aux_work(&esdp->aux_work_data, aux_work, 0);
erts_smp_runq_lock(rq);
@@ -9642,7 +9737,7 @@ Process *schedule(Process *p, int calls)
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
@@ -9651,12 +9746,14 @@ Process *schedule(Process *p, int calls)
}
else if (!ERTS_SCHEDULER_IS_DIRTY(esdp) &&
(fcalls > input_reductions &&
- prepare_for_sys_schedule(esdp, !0))) {
+ prepare_for_sys_schedule(!0))) {
ErtsMonotonicTime current_time;
/*
* Schedule system-level activities.
*/
+ ERTS_MSACC_PUSH_STATE_CACHED_M();
+
erts_smp_atomic32_set_relb(&function_calls, 0);
fcalls = 0;
@@ -9664,7 +9761,9 @@ Process *schedule(Process *p, int calls)
erts_sys_schedule_interrupt(0);
#endif
erts_smp_runq_unlock(rq);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
erl_sys_schedule(1);
+ ERTS_MSACC_POP_STATE_M();
current_time = erts_get_monotonic_time(esdp);
if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
@@ -9722,11 +9821,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;
@@ -9742,9 +9842,12 @@ Process *schedule(Process *p, int calls)
case 0: /* No process at all */
default:
ASSERT(qmask == 0);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER);
goto check_activities_to_run;
}
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_EMULATOR);
+
BM_START_TIMER(system);
/*
@@ -9754,20 +9857,11 @@ Process *schedule(Process *p, int calls)
ASSERT(p); /* Wrong qmask in rq->flags? */
- psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state)
- + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET));
-
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT((state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) !=
- (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC));
- if (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) {
- ASSERT((ERTS_SCHEDULER_IS_DIRTY_CPU(esdp) && (state & ERTS_PSFLG_DIRTY_CPU_PROC)) ||
- (ERTS_SCHEDULER_IS_DIRTY_IO(esdp) && (state & ERTS_PSFLG_DIRTY_IO_PROC)));
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !(state & ERTS_PSFLG_ACTIVE_SYS))
- goto pick_next_process;
- state &= ~(ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q);
- }
-#endif
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ psflg_band_mask = ~((erts_aint32_t) 0);
+ else
+ psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state)
+ + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET));
if (!(state & ERTS_PSFLG_PROXY))
psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ;
@@ -9790,9 +9884,11 @@ Process *schedule(Process *p, int calls)
| ERTS_PSFLG_RUNNING_SYS))) {
tmp = state & (ERTS_PSFLG_SUSPENDED
| ERTS_PSFLG_PENDING_EXIT
- | ERTS_PSFLG_ACTIVE_SYS);
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS);
if (tmp != ERTS_PSFLG_SUSPENDED) {
- if (state & ERTS_PSFLG_ACTIVE_SYS)
+ if (state & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
new |= ERTS_PSFLG_RUNNING_SYS;
else
new |= ERTS_PSFLG_RUNNING;
@@ -9805,7 +9901,8 @@ Process *schedule(Process *p, int calls)
| ERTS_PSFLG_FREE))
|| ((state & (ERTS_PSFLG_SUSPENDED
| ERTS_PSFLG_PENDING_EXIT
- | ERTS_PSFLG_ACTIVE_SYS))
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
== ERTS_PSFLG_SUSPENDED)) {
if (state & ERTS_PSFLG_FREE)
erts_proc_dec_refc(p);
@@ -9824,10 +9921,42 @@ Process *schedule(Process *p, int calls)
esdp->current_process = p;
+
+ reds = context_reds;
+
+#ifdef ERTS_SMP
+
+ erts_smp_runq_unlock(rq);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+#ifdef DEBUG
+ int old_dqbit;
+#endif
+ int dqbit = qbit;
+
+ if (rq == ERTS_DIRTY_CPU_RUNQ)
+ dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET;
+ else {
+ ASSERT(rq == ERTS_DIRTY_IO_RUNQ);
+ dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET;
+ }
+
+#ifdef DEBUG
+ old_dqbit = (int)
+#else
+ (void)
+#endif
+ erts_smp_atomic32_read_band_mb(&p->dirty_state, ~dqbit);
+ ASSERT(old_dqbit & dqbit);
+ }
+#endif /* ERTS_DIRTY_SCHEDULERS */
+
+#endif /* ERTS_SMP */
+
}
#ifdef ERTS_SMP
- erts_smp_runq_unlock(rq);
if (flags & ERTS_RUNQ_FLG_PROTECTED)
(void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED);
@@ -9862,15 +9991,56 @@ Process *schedule(Process *p, int calls)
erts_smp_spin_unlock(&erts_sched_stat.lock);
}
- if (ERTS_PROC_PENDING_EXIT(p)) {
+ ASSERT(!p->scheduler_data);
+ p->scheduler_data = esdp;
+
+ state = erts_smp_atomic32_read_nob(&p->state);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ if (!!(state & ERTS_PSFLGS_DIRTY_WORK)
+ & !(state & ERTS_PSFLG_ACTIVE_SYS)) {
+ /* Migrate to dirty scheduler... */
+ sunlock_sched_out_proc:
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ p->fcalls = reds;
+ goto sched_out_proc;
+
+ }
+ }
+ else {
+ if (state & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_PENDING_EXIT
+ | ERTS_PSFLG_EXITING)) {
+ /* Migrate to normal scheduler... */
+ goto sunlock_sched_out_proc;
+ }
+ if ((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS)
+ && rq == ERTS_DIRTY_IO_RUNQ) {
+ /* Migrate to dirty cpu scheduler... */
+ goto sunlock_sched_out_proc;
+ }
+
+ ASSERT((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS)
+ || *p->i == (BeamInstr) em_call_nif);
+
+ ASSERT(rq == ERTS_DIRTY_CPU_RUNQ
+ ? (state & (ERTS_PSFLG_DIRTY_CPU_PROC
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
+ : (rq == ERTS_DIRTY_IO_RUNQ
+ && (state & ERTS_PSFLG_DIRTY_IO_PROC)));
+ }
+#endif
+
+ if (state & ERTS_PSFLG_PENDING_EXIT) {
erts_handle_pending_exit(p,
ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
state = erts_smp_atomic32_read_nob(&p->state);
}
- ASSERT(!p->scheduler_data);
- p->scheduler_data = esdp;
-#endif
- reds = context_reds;
+
+#endif /* ERTS_SMP */
+
+ p->fcalls = reds;
if (IS_TRACED(p)) {
if (state & ERTS_PSFLG_EXITING) {
@@ -9899,7 +10069,8 @@ Process *schedule(Process *p, int calls)
reds -= execute_sys_tasks(p, &state, reds);
if (reds <= 0
#ifdef ERTS_DIRTY_SCHEDULERS
- || (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC))
+ || ERTS_SCHEDULER_IS_DIRTY(esdp)
+ || (state & ERTS_PSFLGS_DIRTY_WORK)
#endif
) {
p->fcalls = reds;
@@ -9932,13 +10103,13 @@ Process *schedule(Process *p, int calls)
}
}
- if (!(state & ERTS_PSFLG_EXITING)
- && ((FLAGS(p) & F_FORCE_GC)
- || (MSO(p).overhead > BIN_VHEAP_SZ(p)))) {
- reds -= erts_garbage_collect(p, 0, p->arg_reg, p->arity);
- if (reds <= 0) {
- p->fcalls = reds;
- goto sched_out_proc;
+ if (ERTS_IS_GC_DESIRED(p)) {
+ if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & F_DISABLE_GC)) {
+ reds -= erts_garbage_collect_nobump(p, 0, p->arg_reg, p->arity);
+ if (reds <= 0) {
+ p->fcalls = reds;
+ goto sched_out_proc;
+ }
}
}
@@ -9947,7 +10118,6 @@ Process *schedule(Process *p, int calls)
proxy_p = NULL;
}
- p->fcalls = reds;
ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
/* Never run a suspended process */
@@ -9978,7 +10148,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result)
if (rp) {
ErtsProcLocks rp_locks;
ErlOffHeap *ohp;
- ErlHeapFragment* bp;
+ ErtsMessage *mp;
Eterm *hp, msg, req_id, result;
Uint st_result_sz, hsz;
#ifdef DEBUG
@@ -9990,11 +10160,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;
@@ -10019,7 +10185,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result)
ASSERT(hp_start + hsz == hp);
#endif
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (c_p == rp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -10221,10 +10387,10 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
else {
if (!garbage_collected) {
FLAGS(c_p) |= F_NEED_FULLSWEEP;
- reds += erts_garbage_collect(c_p,
- 0,
- c_p->arg_reg,
- c_p->arity);
+ reds += erts_garbage_collect_nobump(c_p,
+ 0,
+ c_p->arg_reg,
+ c_p->arity);
garbage_collected = 1;
}
st_res = am_true;
@@ -10233,7 +10399,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
case ERTS_PSTT_CPC:
st_res = erts_check_process_code(c_p,
st->arg[0],
- st->arg[1] == am_true,
+ unsigned_val(st->arg[1]),
&reds);
if (is_non_value(st_res)) {
/* Needed gc, but gc was disabled */
@@ -10241,6 +10407,10 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
st = NULL;
}
break;
+ case ERTS_PSTT_COHMQ:
+ reds += erts_complete_off_heap_message_queue_change(c_p);
+ st_res = am_true;
+ break;
default:
ERTS_INTERNAL_ERROR("Invalid process sys task type");
st_res = am_false;
@@ -10283,6 +10453,9 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
case ERTS_PSTT_CPC:
st_res = am_false;
break;
+ case ERTS_PSTT_COHMQ:
+ st_res = am_false;
+ break;
default:
ERTS_INTERNAL_ERROR("Invalid process sys task type");
st_res = am_false;
@@ -10301,10 +10474,8 @@ BIF_RETTYPE
erts_internal_request_system_task_3(BIF_ALIST_3)
{
Process *rp = erts_proc_lookup(BIF_ARG_1);
- ErtsProcSysTaskQs *stqs, *free_stqs = NULL;
ErtsProcSysTask *st = NULL;
- erts_aint32_t prio, rp_state;
- int rp_locked;
+ erts_aint32_t prio;
Eterm noproc_res, req_type;
if (!rp && !is_internal_pid(BIF_ARG_1)) {
@@ -10361,7 +10532,6 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
}
st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK,
ERTS_PROC_SYS_TASK_SIZE(tot_sz));
- st->next = st->prev = st; /* Prep for empty prio queue */
ERTS_INIT_OFF_HEAP(&st->off_heap);
hp = &st->heap[0];
@@ -10393,7 +10563,7 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
case am_check_process_code:
if (is_not_atom(st->arg[0]))
goto badarg;
- if (st->arg[1] != am_true && st->arg[1] != am_false)
+ if (is_not_small(st->arg[1]) || (unsigned_val(st->arg[1]) & ~ERTS_CPC_ALL))
goto badarg;
noproc_res = am_false;
st->type = ERTS_PSTT_CPC;
@@ -10405,95 +10575,11 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
goto badarg;
}
- rp_state = erts_smp_atomic32_read_nob(&rp->state);
-
- rp_locked = 0;
-
- free_stqs = NULL;
- if (rp_state & ERTS_PSFLG_ACTIVE_SYS)
- stqs = NULL;
- else {
- alloc_qs:
- stqs = proc_sys_task_queues_alloc();
- stqs->qmask = 1 << prio;
- stqs->ncount = 0;
- stqs->q[PRIORITY_MAX] = NULL;
- stqs->q[PRIORITY_HIGH] = NULL;
- stqs->q[PRIORITY_NORMAL] = NULL;
- stqs->q[PRIORITY_LOW] = NULL;
- stqs->q[prio] = st;
- }
-
- if (!rp_locked) {
- rp_locked = 1;
- erts_smp_proc_lock(rp, ERTS_PROC_LOCK_STATUS);
-
- rp_state = erts_smp_atomic32_read_nob(&rp->state);
- if (rp_state & ERTS_PSFLG_EXITING) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
- rp = NULL;
- free_stqs = stqs;
- goto noproc;
- }
- }
-
- if (!rp->sys_task_qs) {
- if (stqs)
- rp->sys_task_qs = stqs;
- else
- goto alloc_qs;
- }
- else {
- if (stqs)
- free_stqs = stqs;
- stqs = rp->sys_task_qs;
- if (!stqs->q[prio]) {
- stqs->q[prio] = st;
- stqs->qmask |= 1 << prio;
- }
- else {
- st->next = stqs->q[prio];
- st->prev = stqs->q[prio]->prev;
- st->next->prev = st;
- st->prev->next = st;
- ASSERT(stqs->qmask & (1 << prio));
- }
- }
-
- if (ERTS_PSFLGS_GET_ACT_PRIO(rp_state) > prio) {
- erts_aint32_t n, a, e;
- /* Need to elevate actual prio */
-
- a = rp_state;
- do {
- if (ERTS_PSFLGS_GET_ACT_PRIO(a) <= prio) {
- n = a;
- break;
- }
- n = e = a;
- n &= ~ERTS_PSFLGS_ACT_PRIO_MASK;
- n |= (prio << ERTS_PSFLGS_ACT_PRIO_OFFSET);
- a = erts_smp_atomic32_cmpxchg_nob(&rp->state, n, e);
- } while (a != e);
- rp_state = n;
+ if (!schedule_process_sys_task(rp, prio, st)) {
+ noproc:
+ notify_sys_task_executed(BIF_P, st, noproc_res);
}
- /*
- * schedule_process_sys_task() unlocks status
- * lock on process.
- */
- schedule_process_sys_task(rp, rp_state, NULL);
-
- if (free_stqs)
- proc_sys_task_queues_free(free_stqs);
-
- BIF_RET(am_ok);
-
-noproc:
-
- notify_sys_task_executed(BIF_P, st, noproc_res);
- if (free_stqs)
- proc_sys_task_queues_free(free_stqs);
BIF_RET(am_ok);
badarg:
@@ -10502,11 +10588,35 @@ badarg:
erts_cleanup_offheap(&st->off_heap);
erts_free(ERTS_ALC_T_PROC_SYS_TSK, st);
}
- if (free_stqs)
- proc_sys_task_queues_free(free_stqs);
BIF_ERROR(BIF_P, BADARG);
}
+void
+erts_schedule_complete_off_heap_message_queue_change(Eterm pid)
+{
+ Process *rp = erts_proc_lookup(pid);
+ if (rp) {
+ ErtsProcSysTask *st;
+ erts_aint32_t state;
+ int i;
+
+ st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK,
+ ERTS_PROC_SYS_TASK_SIZE(0));
+ st->type = ERTS_PSTT_COHMQ;
+ st->requester = NIL;
+ st->reply_tag = NIL;
+ st->req_id = NIL;
+ st->req_id_sz = 0;
+ for (i = 0; i < ERTS_MAX_PROC_SYS_TASK_ARGS; i++)
+ st->arg[i] = NIL;
+ ERTS_INIT_OFF_HEAP(&st->off_heap);
+ state = erts_smp_atomic32_read_nob(&rp->state);
+
+ if (!schedule_process_sys_task(rp, ERTS_PSFLGS_GET_USR_PRIO(state), st))
+ erts_free(ERTS_ALC_T_PROC_SYS_TSK, st);
+ }
+}
+
static void
save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio)
{
@@ -10892,6 +11002,9 @@ static void early_init_process_struct(void *varg, Eterm data)
Process *proc = arg->proc;
proc->common.id = make_internal_pid(data);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_atomic32_init_nob(&proc->dirty_state, 0);
+#endif
erts_smp_atomic32_init_relb(&proc->state, arg->state);
#ifdef ERTS_SMP
@@ -10952,6 +11065,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. */
@@ -10961,6 +11075,10 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
Eterm res = THE_NON_VALUE;
erts_aint32_t state = 0;
erts_aint32_t prio = (erts_aint32_t) PRIORITY_NORMAL;
+#ifdef SHCOPY_SPAWN
+ erts_shcopy_t info;
+ INITIALIZE_SHCOPY(info);
+#endif
#ifdef ERTS_SMP
erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR);
@@ -10989,6 +11107,15 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
state |= (((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_ACT_PRIO_OFFSET)
| ((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_USR_PRIO_OFFSET));
+ if (so->flags & SPO_OFF_HEAP_MSGQ) {
+ state |= ERTS_PSFLG_OFF_HEAP_MSGQ;
+ flags |= F_OFF_HEAP_MSGQ;
+ }
+ else if (so->flags & SPO_ON_HEAP_MSGQ) {
+ state |= ERTS_PSFLG_ON_HEAP_MSGQ;
+ flags |= F_ON_HEAP_MSGQ;
+ }
+
if (!rq)
rq = erts_get_runq_proc(parent);
@@ -11007,11 +11134,15 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
BM_COUNT(processes_spawned);
BM_SWAP_TIMER(system,size);
+#ifdef SHCOPY_SPAWN
+ arg_size = copy_shared_calculate(args, &info);
+#else
arg_size = size_object(args);
+#endif
BM_SWAP_TIMER(size,system);
heap_need = arg_size;
- p->flags = erts_default_process_flags;
+ p->flags = flags;
p->static_flags = 0;
if (so->flags & SPO_SYSTEM_PROC)
@@ -11060,12 +11191,13 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->stop = p->hend = p->heap + sz;
p->htop = p->heap;
p->heap_sz = sz;
+ p->abandoned_heap = NULL;
+ p->live_hf_end = ERTS_INVALID_HFRAG_PTR;
p->catches = 0;
p->bin_vheap_sz = p->min_vheap_size;
p->bin_old_vheap_sz = p->min_vheap_size;
p->bin_old_vheap = 0;
- p->bin_vheap_mature = 0;
p->sys_task_qs = NULL;
@@ -11084,7 +11216,12 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
BM_MESSAGE(args,p,parent);
BM_START_TIMER(system);
BM_SWAP_TIMER(system,copy);
+#ifdef SHCOPY_SPAWN
+ p->arg_reg[2] = copy_shared_perform(args, arg_size, &info, &p->htop, &p->off_heap);
+ DESTROY_SHCOPY(info);
+#else
p->arg_reg[2] = copy_struct(args, arg_size, &p->htop, &p->off_heap);
+#endif
BM_MESSAGE_COPIED(arg_size);
BM_SWAP_TIMER(copy,system);
p->arity = 3;
@@ -11130,6 +11267,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->accessor_bif_timers = NULL;
#endif
p->mbuf = NULL;
+ p->msg_frag = NULL;
p->mbuf_sz = 0;
p->psd = NULL;
p->dictionary = NULL;
@@ -11265,6 +11403,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;
@@ -11285,7 +11425,6 @@ void erts_init_empty_process(Process *p)
p->bin_old_vheap_sz = BIN_VH_MIN_SIZE;
p->bin_old_vheap = 0;
p->sys_task_qs = NULL;
- p->bin_vheap_mature = 0;
ERTS_PTMR_INIT(p);
p->next = NULL;
p->off_heap.first = NULL;
@@ -11297,6 +11436,7 @@ void erts_init_empty_process(Process *p)
p->old_htop = NULL;
p->old_heap = NULL;
p->mbuf = NULL;
+ p->msg_frag = NULL;
p->mbuf_sz = 0;
p->psd = NULL;
ERTS_P_MONITORS(p) = NULL;
@@ -11354,6 +11494,9 @@ void erts_init_empty_process(Process *p)
p->last_old_htop = NULL;
#endif
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_atomic32_init_nob(&p->dirty_state, 0);
+#endif
erts_smp_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL);
#ifdef ERTS_SMP
@@ -11385,6 +11528,8 @@ erts_debug_verify_clean_empty_process(Process* p)
ASSERT(p->htop == NULL);
ASSERT(p->stop == NULL);
ASSERT(p->hend == NULL);
+ ASSERT(p->abandoned_heap == NULL);
+ ASSERT(p->live_hf_end == ERTS_INVALID_HFRAG_PTR);
ASSERT(p->heap == NULL);
ASSERT(p->common.id == ERTS_INVALID_PID);
ASSERT(ERTS_TRACER_PROC(p) == NIL);
@@ -11462,9 +11607,10 @@ erts_cleanup_empty_process(Process* p)
static void
delete_process(Process* p)
{
- ErlMessage* mp;
-
+ Eterm *heap;
VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] delete process: %p %p %p %p\n", p->common.id,
+ HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)));
/* Cleanup psd */
@@ -11488,16 +11634,17 @@ delete_process(Process* p)
* Release heaps. Clobber contents in DEBUG build.
*/
-
-#ifdef DEBUG
- sys_memset(p->heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm));
-#endif
-
#ifdef HIPE
hipe_delete_process(&p->hipe);
#endif
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) p->heap, p->heap_sz*sizeof(Eterm));
+ heap = p->abandoned_heap ? p->abandoned_heap : p->heap;
+
+#ifdef DEBUG
+ sys_memset(heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm));
+#endif
+
+ ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) heap, p->heap_sz*sizeof(Eterm));
if (p->old_heap != NULL) {
#ifdef DEBUG
@@ -11516,27 +11663,14 @@ delete_process(Process* p)
free_message_buffer(p->mbuf);
}
+ if (p->msg_frag)
+ erts_cleanup_messages(p->msg_frag);
+
erts_erase_dicts(p);
/* free all pending messages */
- mp = p->msg.first;
- while(mp != NULL) {
- ErlMessage* next_mp = mp->next;
- if (mp->data.attached) {
- if (is_value(mp->m[0]))
- free_message_buffer(mp->data.heap_frag);
- else {
- if (is_not_nil(mp->m[1])) {
- ErlHeapFragment *heap_frag;
- heap_frag = (ErlHeapFragment *) mp->data.dist_ext->ext_endp;
- erts_cleanup_offheap(&heap_frag->off_heap);
- }
- erts_free_dist_ext_copy(mp->data.dist_ext);
- }
- }
- free_message(mp);
- mp = next_mp;
- }
+ erts_cleanup_messages(p->msg.first);
+ p->msg.first = NULL;
ASSERT(!p->nodes_monitors);
ASSERT(!p->suspend_monitors);
@@ -11555,7 +11689,9 @@ set_proc_exiting(Process *p,
ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) == ERTS_PROC_LOCKS_ALL);
enqueue = change_proc_schedule_state(p,
- ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT,
+ (ERTS_PSFLG_SUSPENDED
+ | ERTS_PSFLG_PENDING_EXIT
+ | ERTS_PSFLGS_DIRTY_WORK),
ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE,
&state,
&enq_prio,
@@ -11589,10 +11725,7 @@ set_proc_exiting(Process *p,
}
#endif
- if (enqueue)
- add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio),
- state,
- enq_prio);
+ add2runq(enqueue, enq_prio, p, state, NULL);
}
static ERTS_INLINE erts_aint32_t
@@ -11695,6 +11828,11 @@ save_pending_exiter(Process *p)
else
rq = esdp->run_queue;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
+ rq = ERTS_RUNQ_IX(0); /* Handle on ordinary scheduler */
+#endif
+
plp = proclist_create(p);
erts_smp_runq_lock(rq);
@@ -11704,13 +11842,8 @@ save_pending_exiter(Process *p)
non_empty_runq(rq);
erts_smp_runq_unlock(rq);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
- wake_dirty_schedulers(rq, 0);
- else
-#endif
- wake_scheduler(rq);
+ wake_scheduler(rq);
}
#endif
@@ -11724,35 +11857,46 @@ static ERTS_INLINE void
send_exit_message(Process *to, ErtsProcLocks *to_locksp,
Eterm exit_term, Uint term_size, Eterm token)
{
- if (token == NIL
-#ifdef USE_VM_PROBES
- || token == am_have_dt_utag
-#endif
- ) {
- Eterm* hp;
- Eterm mess;
- ErlHeapFragment* bp;
- ErlOffHeap *ohp;
-
- hp = erts_alloc_message_heap(term_size, &bp, &ohp, to, to_locksp);
+ ErtsMessage *mp;
+ ErlOffHeap *ohp;
+ Eterm* hp;
+ Eterm mess;
+#ifdef SHCOPY_SEND
+ erts_shcopy_t info;
+#endif
+
+ if (!have_seqtrace(token)) {
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ term_size = copy_shared_calculate(exit_term, &info);
+ mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp);
+ mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp);
mess = copy_struct(exit_term, term_size, &hp, ohp);
- erts_queue_message(to, to_locksp, bp, mess, NIL);
+#endif
+ erts_queue_message(to, to_locksp, mp, mess, NIL);
} else {
- ErlHeapFragment* bp;
- Eterm* hp;
- Eterm mess;
Eterm temp_token;
Uint sz_token;
ASSERT(is_tuple(token));
sz_token = size_object(token);
- bp = new_message_buffer(term_size+sz_token);
- hp = bp->mem;
- mess = copy_struct(exit_term, term_size, &hp, &bp->off_heap);
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ term_size = copy_shared_calculate(exit_term, &info);
+ mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp);
+ mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp);
+ mess = copy_struct(exit_term, term_size, &hp, ohp);
+#endif
/* the trace token must in this case be updated by the caller */
seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, NULL);
- temp_token = copy_struct(token, sz_token, &hp, &bp->off_heap);
- erts_queue_message(to, to_locksp, bp, mess, temp_token);
+ temp_token = copy_struct(token, sz_token, &hp, ohp);
+ erts_queue_message(to, to_locksp, mp, mess, temp_token);
}
}
@@ -11861,11 +12005,7 @@ send_exit_signal(Process *c_p, /* current process if and only
if ((state & ERTS_PSFLG_TRAP_EXIT)
&& (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) {
- if (is_not_nil(token)
-#ifdef USE_VM_PROBES
- && token != am_have_dt_utag
-#endif
- && token_update)
+ if (have_seqtrace(token) && token_update)
seq_trace_update_send(token_update);
if (is_value(exit_tuple))
send_exit_message(rp, rp_locks, exit_tuple, exit_tuple_sz, token);
@@ -12698,7 +12838,7 @@ stack_element_dump(int to, void *to_arg, Eterm* sp, int yreg)
}
if (is_CP(x)) {
- erts_print(to, to_arg, "Return addr %p (", (Eterm *) EXPAND_POINTER(x));
+ erts_print(to, to_arg, "Return addr %p (", (Eterm *) x);
print_function_from_pc(to, to_arg, cp_val(x));
erts_print(to, to_arg, ")\n");
yreg = 0;
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index ee8a2e1b7b..0c7ad74614 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -304,7 +304,6 @@ typedef enum {
ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN_IX,
ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX,
ERTS_SSI_AUX_WORK_MISC_IX,
- ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX,
ERTS_SSI_AUX_WORK_SET_TMO_IX,
ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX,
ERTS_SSI_AUX_WORK_REAP_PORTS_IX,
@@ -337,8 +336,6 @@ typedef enum {
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX)
#define ERTS_SSI_AUX_WORK_MISC \
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_IX)
-#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN \
- (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX)
#define ERTS_SSI_AUX_WORK_SET_TMO \
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_SET_TMO_IX)
#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK \
@@ -643,12 +640,6 @@ struct ErtsSchedulerData_ {
Process *free_process;
ErtsThrPrgrData thr_progress_data;
#endif
-#if !HEAP_ON_C_STACK
- Eterm tmp_heap[TMP_HEAP_SIZE];
- int num_tmp_heap_used;
- Eterm beam_emu_tmp_heap[BEAM_EMU_TMP_HEAP_SIZE];
- Eterm erl_arith_tmp_heap[ERL_ARITH_TMP_HEAP_SIZE];
-#endif
ErtsSchedulerSleepInfo *ssi;
Process *current_process;
Uint no; /* Scheduler number for normal schedulers */
@@ -702,13 +693,6 @@ extern ErtsAlignedSchedulerData *erts_aligned_dirty_io_scheduler_data;
extern ErtsSchedulerData *erts_scheduler_data;
#endif
-#ifdef ERTS_SCHED_FAIR
-#define ERTS_SCHED_FAIR_YIELD() ETHR_YIELD()
-#else
-#define ERTS_SCHED_FAIR 0
-#define ERTS_SCHED_FAIR_YIELD()
-#endif
-
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
int erts_smp_lc_runq_is_locked(ErtsRunQueue *);
#endif
@@ -924,7 +908,6 @@ struct ErtsPendingSuspend_ {
# define MIN_VHEAP_SIZE(p) (p)->min_vheap_size
# define BIN_VHEAP_SZ(p) (p)->bin_vheap_sz
-# define BIN_VHEAP_MATURE(p) (p)->bin_vheap_mature
# define BIN_OLD_VHEAP_SZ(p) (p)->bin_old_vheap_sz
# define BIN_OLD_VHEAP(p) (p)->bin_old_vheap
@@ -942,6 +925,7 @@ struct process {
Eterm* stop; /* Stack top */
Eterm* heap; /* Heap start */
Eterm* hend; /* Heap end */
+ Eterm* abandoned_heap;
Uint heap_sz; /* Size of heap in words */
Uint min_heap_size; /* Minimum size of heap (in words). */
Uint min_vheap_size; /* Minimum size of virtual heap (in words). */
@@ -1038,18 +1022,22 @@ struct process {
Uint16 gen_gcs; /* Number of (minor) generational GCs. */
Uint16 max_gen_gcs; /* Max minor gen GCs before fullsweep. */
ErlOffHeap off_heap; /* Off-heap data updated by copy_struct(). */
- ErlHeapFragment* mbuf; /* Pointer to message buffer list */
- Uint mbuf_sz; /* Size of all message buffers */
+ ErlHeapFragment* mbuf; /* Pointer to heap fragment list */
+ ErlHeapFragment* live_hf_end;
+ ErtsMessage *msg_frag; /* Pointer to message fragment list */
+ Uint mbuf_sz; /* Total size of heap fragments and message fragments */
ErtsPSD *psd; /* Rarely used process specific data */
Uint64 bin_vheap_sz; /* Virtual heap block size for binaries */
- Uint64 bin_vheap_mature; /* Virtual heap block size for binaries */
Uint64 bin_old_vheap_sz; /* Virtual old heap block size for binaries */
Uint64 bin_old_vheap; /* Virtual old heap size for binaries */
ErtsProcSysTaskQs *sys_task_qs;
erts_smp_atomic32_t state; /* Process state flags (see ERTS_PSFLG_*) */
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_atomic32_t dirty_state; /* Process dirty state flags (see ERTS_PDSFLG_*) */
+#endif
#ifdef ERTS_SMP
ErlMessageInQueue msg_inq;
@@ -1067,6 +1055,7 @@ struct process {
#ifdef CHECK_FOR_HOLES
Eterm* last_htop; /* No need to scan the heap below this point. */
ErlHeapFragment* last_mbuf; /* No need to scan beyond this mbuf. */
+ ErlHeapFragment* heap_hfrag; /* Heap abandoned, htop now lives in this frag */
#endif
#ifdef DEBUG
@@ -1090,6 +1079,7 @@ extern const Process erts_invalid_process;
do { \
(p)->last_htop = 0; \
(p)->last_mbuf = 0; \
+ (p)->heap_hfrag = NULL; \
} while (0)
# define ERTS_HOLE_CHECK(p) erts_check_for_holes((p))
@@ -1167,15 +1157,16 @@ void erts_check_for_holes(Process* p);
#define ERTS_PSFLG_RUNNING_SYS ERTS_PSFLG_BIT(15)
#define ERTS_PSFLG_PROXY ERTS_PSFLG_BIT(16)
#define ERTS_PSFLG_DELAYED_SYS ERTS_PSFLG_BIT(17)
-#ifdef ERTS_DIRTY_SCHEDULERS
-#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(18)
-#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(19)
-#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(20)
-#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(21)
+#define ERTS_PSFLG_OFF_HEAP_MSGQ ERTS_PSFLG_BIT(18)
+#define ERTS_PSFLG_ON_HEAP_MSGQ ERTS_PSFLG_BIT(19)
+#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(20)
+#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(21)
+#define ERTS_PSFLG_DIRTY_ACTIVE_SYS ERTS_PSFLG_BIT(22)
#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 22)
-#else
-#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 18)
-#endif
+
+#define ERTS_PSFLGS_DIRTY_WORK (ERTS_PSFLG_DIRTY_CPU_PROC \
+ | ERTS_PSFLG_DIRTY_IO_PROC \
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS)
#define ERTS_PSFLGS_IN_PRQ_MASK (ERTS_PSFLG_IN_PRQ_MAX \
| ERTS_PSFLG_IN_PRQ_HIGH \
@@ -1189,6 +1180,36 @@ void erts_check_for_holes(Process* p);
#define ERTS_PSFLGS_GET_PRQ_PRIO(PSFLGS) \
(((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.
*/
@@ -1222,12 +1243,16 @@ void erts_check_for_holes(Process* p);
#define SPO_USE_ARGS 2
#define SPO_MONITOR 4
#define SPO_SYSTEM_PROC 8
+#define SPO_OFF_HEAP_MSGQ 16
+#define SPO_ON_HEAP_MSGQ 32
+
+extern int erts_default_spo_flags;
/*
* The following struct contains options for a process to be spawned.
*/
typedef struct {
- Uint flags;
+ int flags;
int error_code; /* Error code returned from create_process(). */
Eterm mref; /* Monitor ref returned (if SPO_MONITOR was given). */
@@ -1267,7 +1292,6 @@ Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra);
Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz);
#endif
-extern Uint erts_default_process_flags;
extern erts_smp_rwmtx_t erts_cpu_bind_rwmtx;
/* If any of the erts_system_monitor_* variables are set (enabled),
** erts_system_monitor must be != NIL, to allow testing on just
@@ -1309,7 +1333,23 @@ extern int erts_system_profile_ts_type;
#define F_HAVE_BLCKD_MSCHED (1 << 8) /* Process has blocked multi-scheduling */
#define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */
#define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */
-#define F_DISABLE_GC (1 << 11) /* Disable GC */
+#define F_DISABLE_GC (1 << 11) /* Disable GC (see below) */
+#define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */
+#define F_ON_HEAP_MSGQ (1 << 13) /* Off heap msg queue */
+#define F_OFF_HEAP_MSGQ_CHNG (1 << 14) /* Off heap msg queue changing */
+#define F_ABANDONED_HEAP_USE (1 << 15) /* Have usage of abandoned heap */
+#define F_DELAY_GC (1 << 16) /* Similar to disable GC (see below) */
+
+/*
+ * 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
@@ -1673,6 +1713,7 @@ void erts_schedule_thr_prgr_later_cleanup_op(void (*)(void *),
void *,
ErtsThrPrgrLaterOp *,
UWord);
+void erts_schedule_complete_off_heap_message_queue_change(Eterm pid);
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
int erts_dbg_check_halloc_lock(Process *p);
@@ -1702,11 +1743,8 @@ Eterm erts_multi_scheduling_blockers(Process *);
void erts_start_schedulers(void);
void erts_alloc_notify_delayed_dealloc(int);
void erts_alloc_ensure_handle_delayed_dealloc_call(int);
-#ifdef ERTS_SMP
void erts_notify_canceled_timer(ErtsSchedulerData *, int);
#endif
-void erts_smp_notify_check_children_needed(void);
-#endif
#if ERTS_USE_ASYNC_READY_Q
void erts_notify_check_async_ready_queue(void *);
#endif
@@ -1800,7 +1838,7 @@ Uint erts_debug_nbalance(void);
int erts_debug_wait_completed(Process *c_p, int flags);
-Uint erts_process_memory(Process *c_p);
+Uint erts_process_memory(Process *c_p, int incl_msg_inq);
#ifdef ERTS_SMP
# define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) ((PROC)->scheduler_data)
@@ -2110,6 +2148,22 @@ ERTS_GLB_INLINE void erts_smp_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq);
ERTS_GLB_INLINE void erts_smp_runqs_lock(ErtsRunQueue *rq1, ErtsRunQueue *rq2);
ERTS_GLB_INLINE void erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2);
+ERTS_GLB_INLINE ErtsMessage *erts_alloc_message_heap_state(Process *pp,
+ erts_aint32_t *psp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp);
+ERTS_GLB_INLINE ErtsMessage *erts_alloc_message_heap(Process *pp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp);
+
+ERTS_GLB_INLINE void erts_shrink_message_heap(ErtsMessage **msgpp, Process *pp,
+ Eterm *start_hp, Eterm *used_hp, Eterm *end_hp,
+ Eterm *brefs, Uint brefs_size);
+
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE
@@ -2258,6 +2312,63 @@ erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2)
#endif
}
+ERTS_GLB_INLINE ErtsMessage *
+erts_alloc_message_heap_state(Process *pp,
+ erts_aint32_t *psp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp)
+{
+ int on_heap;
+
+ if ((*psp) & ERTS_PSFLG_OFF_HEAP_MSGQ) {
+ ErtsMessage *mp = erts_alloc_message(sz, hpp);
+ *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap;
+ return mp;
+ }
+
+ return erts_try_alloc_message_on_heap(pp, psp, plp, sz, hpp, ohpp, &on_heap);
+}
+
+ERTS_GLB_INLINE ErtsMessage *
+erts_alloc_message_heap(Process *pp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp)
+{
+ erts_aint32_t state = erts_smp_atomic32_read_nob(&pp->state);
+ return erts_alloc_message_heap_state(pp, &state, plp, sz, hpp, ohpp);
+}
+
+ERTS_GLB_INLINE void
+erts_shrink_message_heap(ErtsMessage **msgpp, Process *pp,
+ Eterm *start_hp, Eterm *used_hp, Eterm *end_hp,
+ Eterm *brefs, Uint brefs_size)
+{
+ ASSERT(start_hp <= used_hp && used_hp <= end_hp);
+ if ((*msgpp)->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ *msgpp = erts_shrink_message(*msgpp, used_hp - start_hp,
+ brefs, brefs_size);
+ else if (!(*msgpp)->data.attached) {
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN
+ & erts_proc_lc_my_proc_locks(pp));
+ HRelease(pp, end_hp, used_hp);
+ }
+ else {
+ ErlHeapFragment *hfrag = (*msgpp)->data.heap_frag;
+ if (start_hp != used_hp)
+ hfrag = erts_resize_message_buffer(hfrag, used_hp - start_hp,
+ brefs, brefs_size);
+ else {
+ free_message_buffer(hfrag);
+ hfrag = NULL;
+ }
+ (*msgpp)->data.heap_frag = hfrag;
+ }
+}
+
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
ERTS_GLB_INLINE ErtsAtomCacheMap *erts_get_atom_cache_map(Process *c_p);
diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c
index 8606371bdf..36d16f7f42 100644
--- a/erts/emulator/beam/erl_process_dict.c
+++ b/erts/emulator/beam/erl_process_dict.c
@@ -51,16 +51,19 @@
#define INITIAL_SIZE (erts_pd_initial_size)
/* Hash utility macros */
-#define HASH_RANGE(PDict) ((PDict)->homeSize + (PDict)->splitPosition)
+#define HASH_RANGE(PDict) ((PDict)->usedSlots)
-#define MAKE_HASH(Term) \
-((is_small(Term)) ? unsigned_val(Term) : \
- ((is_atom(Term)) ? \
- (atom_tab(atom_val(term))->slot.bucket.hvalue) : \
- make_hash2(Term)))
+#define MAKE_HASH(Term) \
+ ((is_small(Term)) ? unsigned_val(Term) : \
+ ((is_atom(Term)) ? \
+ (atom_tab(atom_val(Term))->slot.bucket.hvalue) : \
+ make_internal_hash(Term)))
#define PD_SZ2BYTES(Sz) (sizeof(ProcDict) + ((Sz) - 1)*sizeof(Eterm))
+#define pd_hash_value(Pdict, Key) \
+ pd_hash_value_to_ix(Pdict, MAKE_HASH((Key)))
+
/* Memory allocation macros */
#define PD_ALLOC(Sz) \
erts_alloc(ERTS_ALC_T_PROC_DICT, (Sz))
@@ -74,14 +77,19 @@
#define TCDR(Term) CDR(list_val(Term))
/* Array access macro */
-#define ARRAY_GET(PDict, Index) (((PDict)->size > (Index)) ? \
- (PDict)->data[Index] : NIL)
+#define ARRAY_GET(PDict, Index) (ASSERT((Index) < (PDict)->arraySize), \
+ (PDict)->data[Index])
+#define ARRAY_PUT(PDict, Index, Val) (ASSERT((Index) < (PDict)->arraySize), \
+ (PDict)->data[Index] = (Val))
+
+#define IS_POW2(X) ((X) && !((X) & ((X)-1)))
/*
* Forward decalarations
*/
static void pd_hash_erase(Process *p, Eterm id, Eterm *ret);
static void pd_hash_erase_all(Process *p);
+static Eterm pd_hash_get_with_hval(Process *p, Eterm bucket, Eterm id);
static Eterm pd_hash_get_keys(Process *p, Eterm value);
static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd);
static Eterm pd_hash_get_all(Process *p, ProcDict *pd);
@@ -91,9 +99,9 @@ static void shrink(Process *p, Eterm* ret);
static void grow(Process *p);
static void array_shrink(ProcDict **ppd, unsigned int need);
-static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term);
+static void ensure_array_size(ProcDict**, unsigned int size);
-static unsigned int pd_hash_value(ProcDict *pdict, Eterm term);
+static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx);
static unsigned int next_array_size(unsigned int need);
/*
@@ -134,6 +142,16 @@ static void pd_check(ProcDict *pd);
** External interface
*/
+int
+erts_pd_set_initial_size(int size)
+{
+ if (size <= 0)
+ return 0;
+
+ erts_pd_initial_size = 1 << erts_fit_in_bits_uint(size-1);
+ return 1;
+}
+
/*
* Called from break handler
*/
@@ -146,9 +164,9 @@ erts_dictionary_dump(int to, void *to_arg, ProcDict *pd)
/*PD_CHECK(pd);*/
if (pd == NULL)
return;
- erts_print(to, to_arg, "(size = %d, used = %d, homeSize = %d, "
+ erts_print(to, to_arg, "(size = %d, usedSlots = %d, "
"splitPosition = %d, numElements = %d)\n",
- pd->size, pd->used, pd->homeSize,
+ pd->arraySize, pd->usedSlots,
pd->splitPosition, (unsigned int) pd->numElements);
for (i = 0; i < HASH_RANGE(pd); ++i) {
erts_print(to, to_arg, "%d: %T\n", i, ARRAY_GET(pd, i));
@@ -203,7 +221,7 @@ erts_dicts_mem_size(Process *p)
{
Uint size = 0;
if (p->dictionary)
- size += PD_SZ2BYTES(p->dictionary->size);
+ size += PD_SZ2BYTES(p->dictionary->arraySize);
return size;
}
@@ -345,7 +363,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret)
if (is_boxed(old)) { /* Tuple */
ASSERT(is_tuple(old));
if (EQ(tuple_val(old)[1], id)) {
- array_put(&(p->dictionary), hval, NIL);
+ ARRAY_PUT(p->dictionary, hval, NIL);
--(p->dictionary->numElements);
*ret = tuple_val(old)[2];
}
@@ -365,7 +383,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret)
old = ARRAY_GET(p->dictionary, hval);
ASSERT(is_list(old));
if (is_nil(TCDR(old))) {
- array_put(&p->dictionary, hval, TCAR(old));
+ ARRAY_PUT(p->dictionary, hval, TCAR(old));
}
} else if (is_not_nil(old)) {
#ifdef DEBUG
@@ -390,40 +408,56 @@ static void pd_hash_erase_all(Process *p)
}
}
+Eterm erts_pd_hash_get_with_hx(Process *p, Uint32 hx, Eterm id)
+{
+ unsigned int hval;
+ ProcDict *pd = p->dictionary;
+
+ ASSERT(hx == MAKE_HASH(id));
+ if (pd == NULL)
+ return am_undefined;
+ hval = pd_hash_value_to_ix(pd, hx);
+ return pd_hash_get_with_hval(p, ARRAY_GET(pd, hval), id);
+}
+
Eterm erts_pd_hash_get(Process *p, Eterm id)
{
unsigned int hval;
- Eterm tmp;
ProcDict *pd = p->dictionary;
if (pd == NULL)
return am_undefined;
hval = pd_hash_value(pd, id);
- tmp = ARRAY_GET(pd, hval);
- if (is_boxed(tmp)) { /* Tuple */
- ASSERT(is_tuple(tmp));
- if (EQ(tuple_val(tmp)[1], id)) {
- return tuple_val(tmp)[2];
+ return pd_hash_get_with_hval(p, ARRAY_GET(pd, hval), id);
+}
+
+Eterm pd_hash_get_with_hval(Process *p, Eterm bucket, Eterm id)
+{
+ if (is_boxed(bucket)) { /* Tuple */
+ ASSERT(is_tuple(bucket));
+ if (EQ(tuple_val(bucket)[1], id)) {
+ return tuple_val(bucket)[2];
}
- } else if (is_list(tmp)) {
- for (; tmp != NIL && !EQ(tuple_val(TCAR(tmp))[1], id); tmp = TCDR(tmp)) {
+ } else if (is_list(bucket)) {
+ for (; bucket != NIL && !EQ(tuple_val(TCAR(bucket))[1], id); bucket = TCDR(bucket)) {
;
}
- if (tmp != NIL) {
- return tuple_val(TCAR(tmp))[2];
+ if (bucket != NIL) {
+ return tuple_val(TCAR(bucket))[2];
}
- } else if (is_not_nil(tmp)) {
+ } else if (is_not_nil(bucket)) {
#ifdef DEBUG
erts_fprintf(stderr,
"Process dictionary for process %T is broken, trying to "
"display term found in line %d:\n"
- "%T\n", p->common.id, __LINE__, tmp);
+ "%T\n", p->common.id, __LINE__, bucket);
#endif
erl_exit(1, "Damaged process dictionary found during get/1.");
}
return am_undefined;
}
+
#define PD_GET_TKEY(Dst,Src) \
do { \
ASSERT(is_tuple((Src))); \
@@ -549,8 +583,11 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
if (p->dictionary == NULL) {
/* Create it */
- array_put(&(p->dictionary), INITIAL_SIZE - 1, NIL);
- p->dictionary->homeSize = INITIAL_SIZE;
+ ensure_array_size(&p->dictionary, INITIAL_SIZE);
+ p->dictionary->usedSlots = INITIAL_SIZE;
+ p->dictionary->sizeMask = INITIAL_SIZE*2 - 1;
+ p->dictionary->splitPosition = 0;
+ p->dictionary->numElements = 0;
}
hval = pd_hash_value(p->dictionary, id);
old = ARRAY_GET(p->dictionary, hval);
@@ -583,7 +620,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
root[0] = id;
root[1] = value;
root[2] = old;
- BUMP_REDS(p, erts_garbage_collect(p, needed, root, 3));
+ erts_garbage_collect(p, needed, root, 3);
id = root[0];
value = root[1];
old = root[2];
@@ -602,19 +639,19 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
* Update the dictionary.
*/
if (is_nil(old)) {
- array_put(&(p->dictionary), hval, tpl);
+ ARRAY_PUT(p->dictionary, hval, tpl);
++(p->dictionary->numElements);
} else if (is_boxed(old)) {
ASSERT(is_tuple(old));
if (EQ(tuple_val(old)[1],id)) {
- array_put(&(p->dictionary), hval, tpl);
+ ARRAY_PUT(p->dictionary, hval, tpl);
return tuple_val(old)[2];
} else {
hp = HeapOnlyAlloc(p, 4);
tmp = CONS(hp, old, NIL);
hp += 2;
++(p->dictionary->numElements);
- array_put(&(p->dictionary), hval, CONS(hp, tpl, tmp));
+ ARRAY_PUT(p->dictionary, hval, CONS(hp, tpl, tmp));
hp += 2;
ASSERT(hp <= hp_limit);
}
@@ -624,7 +661,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
* New key. Simply prepend the tuple to the beginning of the list.
*/
hp = HeapOnlyAlloc(p, 2);
- array_put(&(p->dictionary), hval, CONS(hp, tpl, old));
+ ARRAY_PUT(p->dictionary, hval, CONS(hp, tpl, old));
hp += 2;
ASSERT(hp <= hp_limit);
++(p->dictionary->numElements);
@@ -659,7 +696,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
nlist = CONS(hp, tpl, nlist);
hp += 2;
ASSERT(hp <= hp_limit);
- array_put(&(p->dictionary), hval, nlist);
+ ARRAY_PUT(p->dictionary, hval, nlist);
return tuple_val(TCAR(tmp))[2];
}
} else {
@@ -684,6 +721,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
static void shrink(Process *p, Eterm* ret)
{
+ ProcDict *pd = p->dictionary;
unsigned int range = HASH_RANGE(p->dictionary);
unsigned int steps = (range*3) / 10;
Eterm hi, lo, tmp;
@@ -698,25 +736,26 @@ static void shrink(Process *p, Eterm* ret)
}
for (i = 0; i < steps; ++i) {
- ProcDict *pd = p->dictionary;
if (pd->splitPosition == 0) {
- pd->homeSize /= 2;
- pd->splitPosition = pd->homeSize;
+ ASSERT(IS_POW2(pd->usedSlots));
+ pd->sizeMask = pd->usedSlots - 1;
+ pd->splitPosition = pd->usedSlots / 2;
}
--(pd->splitPosition);
- hi = ARRAY_GET(pd, (pd->splitPosition + pd->homeSize));
+ /* Must wait to decrement 'usedSlots' for GC rootset below */
+ hi = ARRAY_GET(pd, pd->usedSlots - 1);
lo = ARRAY_GET(pd, pd->splitPosition);
if (hi != NIL) {
if (lo == NIL) {
- array_put(&(p->dictionary), pd->splitPosition, hi);
+ ARRAY_PUT(pd, pd->splitPosition, hi);
} else {
- int needed = 4;
+ Sint needed = 4;
if (is_list(hi) && is_list(lo)) {
needed = 2*erts_list_length(hi);
}
if (HeapWordsLeft(p) < needed) {
- BUMP_REDS(p, erts_garbage_collect(p, needed, ret, 1));
- hi = pd->data[(pd->splitPosition + pd->homeSize)];
+ erts_garbage_collect(p, needed, ret, 1);
+ hi = pd->data[pd->usedSlots - 1];
lo = pd->data[pd->splitPosition];
}
#ifdef DEBUG
@@ -727,13 +766,13 @@ static void shrink(Process *p, Eterm* ret)
hp = HeapOnlyAlloc(p, 4);
tmp = CONS(hp, hi, NIL);
hp += 2;
- array_put(&(p->dictionary), pd->splitPosition,
+ ARRAY_PUT(pd, pd->splitPosition,
CONS(hp,lo,tmp));
hp += 2;
ASSERT(hp <= hp_limit);
} else { /* hi is a list */
hp = HeapOnlyAlloc(p, 2);
- array_put(&(p->dictionary), pd->splitPosition,
+ ARRAY_PUT(pd, pd->splitPosition,
CONS(hp, lo, hi));
hp += 2;
ASSERT(hp <= hp_limit);
@@ -741,7 +780,7 @@ static void shrink(Process *p, Eterm* ret)
} else { /* lo is a list */
if (is_tuple(hi)) {
hp = HeapOnlyAlloc(p, 2);
- array_put(&(p->dictionary), pd->splitPosition,
+ ARRAY_PUT(pd, pd->splitPosition,
CONS(hp, hi, lo));
hp += 2;
ASSERT(hp <= hp_limit);
@@ -753,14 +792,15 @@ static void shrink(Process *p, Eterm* ret)
hp += 2;
}
ASSERT(hp <= hp_limit);
- array_put(&(p->dictionary), pd->splitPosition, lo);
+ ARRAY_PUT(pd, pd->splitPosition, lo);
}
}
}
}
- array_put(&(p->dictionary), (pd->splitPosition + pd->homeSize), NIL);
+ --pd->usedSlots;
+ ARRAY_PUT(pd, pd->usedSlots, NIL);
}
- if (HASH_RANGE(p->dictionary) <= (p->dictionary->size / 4)) {
+ if (HASH_RANGE(p->dictionary) <= (p->dictionary->arraySize / 4)) {
array_shrink(&(p->dictionary), (HASH_RANGE(p->dictionary) * 3) / 2);
}
}
@@ -768,14 +808,14 @@ static void shrink(Process *p, Eterm* ret)
static void grow(Process *p)
{
unsigned int i,j;
- unsigned int steps = p->dictionary->homeSize / 5;
+ unsigned int steps = (p->dictionary->usedSlots / 4) & 0xf;
Eterm l1,l2;
Eterm l;
Eterm *hp;
unsigned int pos;
unsigned int homeSize;
- int needed = 0;
- ProcDict *pd;
+ Sint needed = 0;
+ ProcDict *pd = p->dictionary;
#ifdef DEBUG
Eterm *hp_limit;
#endif
@@ -784,18 +824,20 @@ static void grow(Process *p)
if (steps == 0)
steps = 1;
/* Dont grow over MAX_HASH */
- if ((MAX_HASH - steps) <= HASH_RANGE(p->dictionary)) {
+ if ((MAX_HASH - steps) <= HASH_RANGE(pd)) {
return;
}
+ ensure_array_size(&p->dictionary, HASH_RANGE(pd) + steps);
+ pd = p->dictionary;
+
/*
* Calculate total number of heap words needed, and garbage collect
* if necessary.
*/
- pd = p->dictionary;
pos = pd->splitPosition;
- homeSize = pd->homeSize;
+ homeSize = pd->usedSlots - pd->splitPosition;
for (i = 0; i < steps; ++i) {
if (pos == homeSize) {
homeSize *= 2;
@@ -811,7 +853,7 @@ static void grow(Process *p)
}
}
if (HeapWordsLeft(p) < needed) {
- BUMP_REDS(p, erts_garbage_collect(p, needed, 0, 0));
+ erts_garbage_collect(p, needed, 0, 0);
}
#ifdef DEBUG
hp_limit = p->htop + needed;
@@ -820,21 +862,22 @@ static void grow(Process *p)
/*
* Now grow.
*/
-
+ homeSize = pd->usedSlots - pd->splitPosition;
for (i = 0; i < steps; ++i) {
- ProcDict *pd = p->dictionary;
- if (pd->splitPosition == pd->homeSize) {
- pd->homeSize *= 2;
- pd->splitPosition = 0;
+ if (pd->splitPosition == homeSize) {
+ homeSize *= 2;
+ pd->sizeMask = homeSize*2 - 1;
+ pd->splitPosition = 0;
}
pos = pd->splitPosition;
++pd->splitPosition; /* For the hashes */
+ ++pd->usedSlots;
+ ASSERT(pos + homeSize == pd->usedSlots - 1);
l = ARRAY_GET(pd, pos);
if (is_tuple(l)) {
if (pd_hash_value(pd, tuple_val(l)[1]) != pos) {
- array_put(&(p->dictionary), pos +
- p->dictionary->homeSize, l);
- array_put(&(p->dictionary), pos, NIL);
+ ARRAY_PUT(pd, pos + homeSize, l);
+ ARRAY_PUT(pd, pos, NIL);
}
} else {
l2 = NIL;
@@ -856,10 +899,8 @@ static void grow(Process *p)
if (l2 != NIL && TCDR(l2) == NIL)
l2 = TCAR(l2);
ASSERT(hp <= hp_limit);
- /* After array_put pd is no longer valid */
- array_put(&(p->dictionary), pos, l1);
- array_put(&(p->dictionary), pos +
- p->dictionary->homeSize, l2);
+ ARRAY_PUT(pd, pos, l1);
+ ARRAY_PUT(pd, pos + homeSize, l2);
}
}
@@ -876,73 +917,65 @@ static void array_shrink(ProcDict **ppd, unsigned int need)
{
unsigned int siz = next_array_size(need);
- HDEBUGF(("array_shrink: size = %d, used = %d, need = %d",
- (*ppd)->size, (*ppd)->used, need));
+ HDEBUGF(("array_shrink: size = %d, need = %d",
+ (*ppd)->arraySize, need));
- if (siz > (*ppd)->size)
+ if (siz >= (*ppd)->arraySize)
return; /* Only shrink */
*ppd = PD_REALLOC(((void *) *ppd),
- PD_SZ2BYTES((*ppd)->size),
+ PD_SZ2BYTES((*ppd)->arraySize),
PD_SZ2BYTES(siz));
- (*ppd)->size = siz;
- if ((*ppd)->size < (*ppd)->used)
- (*ppd)->used = (*ppd)->size;
+ (*ppd)->arraySize = siz;
}
-static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term)
+static void ensure_array_size(ProcDict **ppdict, unsigned int size)
{
+ ProcDict *pd = *ppdict;
unsigned int i;
- Eterm ret;
- if (*ppdict == NULL) {
- Uint siz = next_array_size(ndx+1);
- ProcDict *p;
- p = PD_ALLOC(PD_SZ2BYTES(siz));
+ if (pd == NULL) {
+ Uint siz = next_array_size(size);
+
+ pd = PD_ALLOC(PD_SZ2BYTES(siz));
for (i = 0; i < siz; ++i)
- p->data[i] = NIL;
- p->size = siz;
- p->homeSize = p->splitPosition = p->numElements = p->used = 0;
- *ppdict = p;
- } else if (ndx >= (*ppdict)->size) {
- Uint osize = (*ppdict)->size;
- Uint nsize = next_array_size(ndx+1);
- *ppdict = PD_REALLOC(((void *) *ppdict),
+ pd->data[i] = NIL;
+ pd->arraySize = siz;
+ *ppdict = pd;
+ } else if (size > pd->arraySize) {
+ Uint osize = pd->arraySize;
+ Uint nsize = next_array_size(size);
+ pd = PD_REALLOC(((void *) pd),
PD_SZ2BYTES(osize),
PD_SZ2BYTES(nsize));
for (i = osize; i < nsize; ++i)
- (*ppdict)->data[i] = NIL;
- (*ppdict)->size = nsize;
+ pd->data[i] = NIL;
+ pd->arraySize = nsize;
+ *ppdict = pd;
}
- ret = (*ppdict)->data[ndx];
- (*ppdict)->data[ndx] = term;
- if ((ndx + 1) > (*ppdict)->used)
- (*ppdict)->used = ndx + 1;
-#ifdef HARDDEBUG
- HDEBUGF(("array_put: (*ppdict)->size = %d, (*ppdict)->used = %d, ndx = %d",
- (*ppdict)->size, (*ppdict)->used, ndx));
- erts_fprintf(stderr, "%T", term);
-#endif /* HARDDEBUG */
- return ret;
}
/*
** Basic utilities
*/
-static unsigned int pd_hash_value(ProcDict *pdict, Eterm term)
+static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx)
{
- Uint hash, high;
+ Uint high;
- hash = MAKE_HASH(term);
- high = hash % (pdict->homeSize*2);
+ ASSERT(IS_POW2(pdict->sizeMask+1));
+ ASSERT(HASH_RANGE(pdict) >= (pdict->sizeMask >> 1));
+ ASSERT(HASH_RANGE(pdict) <= (pdict->sizeMask + 1));
+
+ high = hx & pdict->sizeMask;
if (high >= HASH_RANGE(pdict))
- return hash % pdict->homeSize;
+ return hx & (pdict->sizeMask >> 1);
return high;
}
+
static unsigned int next_array_size(unsigned int need)
{
static unsigned int tab[] =
@@ -1002,24 +1035,28 @@ 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;
@@ -1030,7 +1067,7 @@ static void pd_check(ProcDict *pd)
}
}
ASSERT(num == pd->numElements);
- ASSERT(pd->splitPosition <= pd->homeSize);
+ ASSERT(pd->usedSlots >= pd->splitPosition*2);
}
#endif /* DEBUG */
diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h
index cc53800eb5..dac214c8a1 100644
--- a/erts/emulator/beam/erl_process_dict.h
+++ b/erts/emulator/beam/erl_process_dict.h
@@ -23,14 +23,18 @@
#include "sys.h"
typedef struct proc_dict {
- unsigned int size;
- unsigned int used;
- unsigned int homeSize;
+ unsigned int sizeMask;
+ unsigned int usedSlots;
+ unsigned int arraySize;
unsigned int splitPosition;
Uint numElements;
Eterm data[1]; /* The beginning of an array of erlang terms */
} ProcDict;
+#define ERTS_PD_START(PD) ((PD)->data)
+#define ERTS_PD_SIZE(PD) ((PD)->usedSlots)
+
+int erts_pd_set_initial_size(int size);
Uint erts_dicts_mem_size(struct process *p);
void erts_erase_dicts(struct process *p);
void erts_dictionary_dump(int to, void *to_arg, ProcDict *pd);
@@ -39,5 +43,6 @@ void erts_deep_dictionary_dump(int to, void *to_arg,
Eterm erts_dictionary_copy(struct process *p, ProcDict *pd);
Eterm erts_pd_hash_get(struct process *p, Eterm id);
+Eterm erts_pd_hash_get_with_hx(Process *p, Uint32 hx, Eterm id);
#endif
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 25f0b1ed38..39c36ee7a9 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -78,13 +78,14 @@ erts_deep_process_dump(int to, void *to_arg)
dump_binaries(to, to_arg, all_binaries);
}
-Uint erts_process_memory(Process *p) {
- ErlMessage *mp;
+Uint erts_process_memory(Process *p, int incl_msg_inq) {
+ ErtsMessage *mp;
Uint size = 0;
struct saved_calls *scb;
size += sizeof(Process);
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
+ if (incl_msg_inq)
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
erts_doforall_links(ERTS_P_LINKS(p), &erts_one_link_size, &size);
erts_doforall_monitors(ERTS_P_MONITORS(p), &erts_one_mon_size, &size);
@@ -92,7 +93,7 @@ Uint erts_process_memory(Process *p) {
if (p->old_hend && p->old_heap)
size += (p->old_hend - p->old_heap) * sizeof(Eterm);
- size += p->msg.len * sizeof(ErlMessage);
+ size += p->msg.len * sizeof(ErtsMessage);
for (mp = p->msg.first; mp; mp = mp->next)
if (mp->data.attached)
@@ -119,7 +120,7 @@ static void
dump_process_info(int to, void *to_arg, Process *p)
{
Eterm* sp;
- ErlMessage* mp;
+ ErtsMessage* mp;
int yreg = -1;
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
@@ -365,7 +366,7 @@ heap_dump(int to, void *to_arg, Eterm x)
while (x != OUR_NIL) {
if (is_CP(x)) {
- next = (Eterm *) EXPAND_POINTER(x);
+ next = (Eterm *) x;
} else if (is_list(x)) {
ptr = list_val(x);
if (ptr[0] != OUR_NIL) {
@@ -378,7 +379,7 @@ heap_dump(int to, void *to_arg, Eterm x)
ptr[1] = make_small(0);
}
x = ptr[0];
- ptr[0] = (Eterm) COMPRESS_POINTER(next);
+ ptr[0] = (Eterm) next;
next = ptr + 1;
continue;
}
@@ -408,7 +409,7 @@ heap_dump(int to, void *to_arg, Eterm x)
ptr[0] = OUR_NIL;
} else {
x = ptr[arity];
- ptr[0] = (Eterm) COMPRESS_POINTER(next);
+ ptr[0] = (Eterm) next;
next = ptr + arity - 1;
continue;
}
@@ -617,7 +618,7 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) {
if (psflg)
erts_print(to, to_arg, " | ");
- for (i = 0; i < ERTS_PSFLG_MAX && psflg; i++) {
+ for (i = 0; i <= ERTS_PSFLG_MAX && psflg; i++) {
erts_aint32_t chk = (1 << i);
if (psflg & chk) {
switch (chk) {
@@ -657,16 +658,16 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) {
erts_print(to, to_arg, "PROXY"); break;
case ERTS_PSFLG_DELAYED_SYS:
erts_print(to, to_arg, "DELAYED_SYS"); break;
-#ifdef ERTS_DIRTY_SCHEDULERS
+ case ERTS_PSFLG_OFF_HEAP_MSGQ:
+ erts_print(to, to_arg, "OFF_HEAP_MSGQ"); break;
+ case ERTS_PSFLG_ON_HEAP_MSGQ:
+ erts_print(to, to_arg, "ON_HEAP_MSGQ"); break;
case ERTS_PSFLG_DIRTY_CPU_PROC:
erts_print(to, to_arg, "DIRTY_CPU_PROC"); break;
case ERTS_PSFLG_DIRTY_IO_PROC:
erts_print(to, to_arg, "DIRTY_IO_PROC"); break;
- case ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q:
- erts_print(to, to_arg, "DIRTY_CPU_PROC_IN_Q"); break;
- case ERTS_PSFLG_DIRTY_IO_PROC_IN_Q:
- erts_print(to, to_arg, "DIRTY_IO_PROC_IN_Q"); break;
-#endif
+ case ERTS_PSFLG_DIRTY_ACTIVE_SYS:
+ erts_print(to, to_arg, "DIRTY_ACTIVE_SYS"); break;
default:
erts_print(to, to_arg, "UNKNOWN(%d)", chk); break;
}
diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c
index e5050bfaa5..e31d3a951d 100644
--- a/erts/emulator/beam/erl_term.c
+++ b/erts/emulator/beam/erl_term.c
@@ -28,6 +28,37 @@
#include <stdlib.h>
#include <stdio.h>
+void
+erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz)
+{
+#ifdef TAG_LITERAL_PTR
+ Eterm *hp_end, *hp;
+
+ hp_end = hp_start + hsz;
+ hp = hp_start;
+
+ while (hp < hp_end) {
+ switch (primary_tag(*hp)) {
+ case TAG_PRIMARY_BOXED:
+ case TAG_PRIMARY_LIST:
+ *hp |= TAG_LITERAL_PTR;
+ break;
+ case TAG_PRIMARY_HEADER:
+ if (header_is_thing(*hp)) {
+ hp += thing_arityval(*hp);
+ }
+ break;
+ default:
+ break;
+ }
+
+ hp++;
+ }
+ if (is_boxed(*term) || is_list(*term))
+ *term |= TAG_LITERAL_PTR;
+#endif
+}
+
__decl_noreturn static void __noreturn
et_abort(const char *expr, const char *file, unsigned line)
{
@@ -174,9 +205,7 @@ ET_DEFINE_CHECKED(Uint,external_thing_data_words,ExternalThing*,is_thing_ptr);
ET_DEFINE_CHECKED(Eterm,make_cp,UWord *,_is_taggable_pointer);
ET_DEFINE_CHECKED(UWord *,cp_val,Eterm,is_CP);
ET_DEFINE_CHECKED(Uint,catch_val,Eterm,is_catch);
-ET_DEFINE_CHECKED(Uint,x_reg_offset,Uint,_is_xreg);
-ET_DEFINE_CHECKED(Uint,y_reg_offset,Uint,_is_yreg);
-ET_DEFINE_CHECKED(Uint,x_reg_index,Uint,_is_xreg);
-ET_DEFINE_CHECKED(Uint,y_reg_index,Uint,_is_yreg);
+ET_DEFINE_CHECKED(Uint,loader_x_reg_index,Uint,_is_loader_x_reg);
+ET_DEFINE_CHECKED(Uint,loader_y_reg_index,Uint,_is_loader_y_reg);
#endif /* ET_DEBUG */
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index d5e91d80d9..2b28762db5 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -21,34 +21,10 @@
#ifndef __ERL_TERM_H
#define __ERL_TERM_H
-#include "sys.h" /* defines HALFWORD_HEAP */
+#include "erl_mmap.h"
typedef UWord Wterm; /* Full word terms */
-#if HALFWORD_HEAP
-# define HEAP_ON_C_STACK 0
-# if HALFWORD_ASSERT
-# ifdef ET_DEBUG
-# undef ET_DEBUG
-# endif
-# define ET_DEBUG 1
-# endif
-# if 1
-# define CHECK_POINTER_MASK 0xFFFFFFFF00000000UL
-# define COMPRESS_POINTER(APointer) ((Eterm) (UWord) (APointer))
-# define EXPAND_POINTER(AnEterm) ((UWord) (AnEterm))
-# else
-# define CHECK_POINTER_MASK 0x0UL
-# define COMPRESS_POINTER(AnUint) (AnUint)
-# define EXPAND_POINTER(APointer) (APointer)
-# endif
-#else
-# define HEAP_ON_C_STACK 1
-# define CHECK_POINTER_MASK 0x0UL
-# define COMPRESS_POINTER(AnUint) (AnUint)
-# define EXPAND_POINTER(APointer) (APointer)
-#endif
-
struct erl_node_; /* Declared in erl_node_tables.h */
/*
@@ -74,6 +50,24 @@ struct erl_node_; /* Declared in erl_node_tables.h */
#define _ET_APPLY(F,X) _unchecked_##F(X)
#endif
+#if defined(ARCH_64)
+# define TAG_PTR_MASK__ 0x7
+# if !defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+# ifdef HIPE
+# error Hipe on 64-bit needs a real mmap as it does not support the literal tag
+# endif
+# define TAG_LITERAL_PTR 0x4
+# else
+# undef TAG_LITERAL_PTR
+# endif
+#elif defined(ARCH_32)
+# define TAG_PTR_MASK__ 0x3
+# undef TAG_LITERAL_PTR
+#else
+# error Not supported arch
+#endif
+
+
#define _TAG_PRIMARY_SIZE 2
#define _TAG_PRIMARY_MASK 0x3
#define TAG_PRIMARY_HEADER 0x0
@@ -190,15 +184,13 @@ struct erl_node_; /* Declared in erl_node_tables.h */
/* boxed object access methods */
-#if HALFWORD_HEAP
-#define _is_taggable_pointer(x) (((UWord)(x) & (CHECK_POINTER_MASK | 0x3)) == 0)
-#define _boxed_precond(x) (is_boxed(x))
-#else
-#define _is_taggable_pointer(x) (((Uint)(x) & 0x3) == 0)
+
+#define _is_taggable_pointer(x) (((Uint)(x) & TAG_PTR_MASK__) == 0)
+
#define _boxed_precond(x) (is_boxed(x))
-#endif
-#define _is_aligned(x) (((Uint)(x) & 0x3) == 0)
-#define _unchecked_make_boxed(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_BOXED)
+
+#define _is_aligned(x) (((Uint)(x) & TAG_PTR_MASK__) == 0)
+#define _unchecked_make_boxed(x) ((Uint)(x) + TAG_PRIMARY_BOXED)
_ET_DECLARE_CHECKED(Eterm,make_boxed,const Eterm*)
#define make_boxed(x) _ET_APPLY(make_boxed,(x))
#if 1
@@ -209,12 +201,16 @@ _ET_DECLARE_CHECKED(int,is_boxed,Eterm)
#else
#define is_boxed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED)
#endif
-#define _unchecked_boxed_val(x) ((Eterm*) EXPAND_POINTER(((x) - TAG_PRIMARY_BOXED)))
+#ifdef TAG_LITERAL_PTR
+#define _unchecked_boxed_val(x) _unchecked_ptr_val(x)
+#else
+#define _unchecked_boxed_val(x) ((Eterm*) ((x) - TAG_PRIMARY_BOXED))
+#endif
_ET_DECLARE_CHECKED(Eterm*,boxed_val,Wterm)
#define boxed_val(x) _ET_APPLY(boxed_val,(x))
/* cons cell ("list") access methods */
-#define _unchecked_make_list(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_LIST)
+#define _unchecked_make_list(x) ((Uint)(x) + TAG_PRIMARY_LIST)
_ET_DECLARE_CHECKED(Eterm,make_list,const Eterm*)
#define make_list(x) _ET_APPLY(make_list,(x))
#if 1
@@ -226,12 +222,12 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm)
#define is_list(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_LIST)
#define is_not_list(x) (!is_list((x)))
#endif
-#if HALFWORD_HEAP
#define _list_precond(x) (is_list(x))
+#ifdef TAG_LITERAL_PTR
+#define _unchecked_list_val(x) _unchecked_ptr_val(x)
#else
-#define _list_precond(x) (is_list(x))
+#define _unchecked_list_val(x) ((Eterm*) ((x) - TAG_PRIMARY_LIST))
#endif
-#define _unchecked_list_val(x) ((Eterm*) EXPAND_POINTER((x) - TAG_PRIMARY_LIST))
_ET_DECLARE_CHECKED(Eterm*,list_val,Wterm)
#define list_val(x) _ET_APPLY(list_val,(x))
@@ -242,15 +238,22 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm)
#define CDR(x) ((x)[1])
/* generic tagged pointer (boxed or list) access methods */
-#define _unchecked_ptr_val(x) ((Eterm*) EXPAND_POINTER((x) & ~((Uint) 0x3)))
+#define _unchecked_ptr_val(x) ((Eterm*) ((x) & ~((Uint) TAG_PTR_MASK__)))
#define ptr_val(x) _unchecked_ptr_val((x)) /*XXX*/
#define _unchecked_offset_ptr(x,offs) ((x)+((offs)*sizeof(Eterm)))
#define offset_ptr(x,offs) _unchecked_offset_ptr(x,offs) /*XXX*/
#define _unchecked_byte_offset_ptr(x,byte_offs) ((x)+(offs))
#define byte_offset_ptr(x,offs) _unchecked_byte_offset_ptr(x,offs) /*XXX*/
+#ifdef TAG_LITERAL_PTR
+#define _unchecked_is_not_literal_ptr(x) (!((x) & TAG_LITERAL_PTR))
+#define is_not_literal_ptr(x) _unchecked_is_not_literal_ptr((x)) /*XXX*/
+#define is_literal_ptr(x) (!is_not_literal_ptr((x))) /*XXX*/
+#endif
+
+
/* fixnum ("small") access methods */
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define SMALL_BITS (64-4)
#define SMALL_DIGITS (17)
#else
@@ -396,11 +399,7 @@ _ET_DECLARE_CHECKED(Eterm*,fun_val,Wterm)
_ET_DECLARE_CHECKED(Eterm*,export_val,Wterm)
#define export_val(x) _ET_APPLY(export_val,(x))
#define is_export_header(x) ((x) == HEADER_EXPORT)
-#if HALFWORD_HEAP
-#define HEADER_EXPORT _make_header(2,_TAG_HEADER_EXPORT)
-#else
#define HEADER_EXPORT _make_header(1,_TAG_HEADER_EXPORT)
-#endif
/* bignum access methods */
#define make_pos_bignum_header(sz) _make_header((sz),_TAG_HEADER_POS_BIG)
@@ -424,7 +423,7 @@ _ET_DECLARE_CHECKED(Eterm*,big_val,Wterm)
#define big_val(x) _ET_APPLY(big_val,(x))
/* flonum ("float") access methods */
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define HEADER_FLONUM _make_header(1,_TAG_HEADER_FLOAT)
#else
#define HEADER_FLONUM _make_header(2,_TAG_HEADER_FLOAT)
@@ -445,12 +444,12 @@ typedef union float_def
byte fb[sizeof(ieee754_8)];
Uint16 fs[sizeof(ieee754_8) / sizeof(Uint16)];
Uint32 fw[sizeof(ieee754_8) / sizeof(Uint32)];
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
Uint fdw;
#endif
} FloatDef;
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fdw = *((fval)+1)
@@ -727,7 +726,7 @@ _ET_DECLARE_CHECKED(struct erl_node_*,internal_port_node,Eterm)
#define ERTS_MAX_REF_NUMBERS 3
#define ERTS_REF_NUMBERS ERTS_MAX_REF_NUMBERS
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
# define ERTS_REF_WORDS (ERTS_REF_NUMBERS/2 + 1)
# define ERTS_REF_32BIT_WORDS (ERTS_REF_NUMBERS+1)
#else
@@ -749,7 +748,7 @@ typedef struct {
#define make_ref_thing_header(DW) \
_make_header((DW)+REF_THING_HEAD_SIZE-1,_TAG_HEADER_REF)
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
/*
* Ref layout on a 64-bit little endian machine:
@@ -1009,27 +1008,20 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm)
#define MAP_HEADER_VAL(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS + MAP_HEADER_TAG_SZ + MAP_HEADER_ARITY_SZ)) & (0xffff))
#define make_hashmap(x) make_boxed((Eterm*)(x))
-#define make_hashmap_rel make_boxed_rel
#define is_hashmap(x) (is_boxed((x)) && is_hashmap_header(*boxed_val((x))))
#define is_not_hashmap(x) (!is_hashmap(x))
-#define is_hashmap_rel(RTERM,BASE) is_hashmap(rterm2wterm(RTERM,BASE))
#define is_hashmap_header(x) (((x) & (_HEADER_MAP_HASHMAP_HEAD_MASK)) == HAMT_SUBTAG_HEAD_ARRAY)
#define hashmap_val(x) _unchecked_boxed_val((x))
-#define hashmap_val_rel(RTERM, BASE) hashmap_val(rterm2wterm(RTERM, BASE))
#define make_flatmap(x) make_boxed((Eterm*)(x))
-#define make_flatmap_rel(x, BASE) make_boxed_rel((Eterm*)(x),(BASE))
#define is_flatmap(x) (is_boxed((x)) && is_flatmap_header(*boxed_val((x))))
-#define is_flatmap_rel(RTERM,BASE) is_flatmap(rterm2wterm(RTERM,BASE))
#define is_not_flatmap(x) (!is_flatmap((x)))
#define is_flatmap_header(x) (((x) & (_HEADER_MAP_SUBTAG_MASK)) == HAMT_SUBTAG_HEAD_FLATMAP)
#define flatmap_val(x) (_unchecked_boxed_val((x)))
-#define flatmap_val_rel(RTERM, BASE) flatmap_val(rterm2wterm(RTERM, BASE))
#define is_map_header(x) (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_MAP)
#define is_map(x) (is_boxed((x)) && is_map_header(*boxed_val(x)))
#define is_not_map(x) (!is_map(x))
-#define is_map_rel(RTERM,BASE) is_map(rterm2wterm(RTERM,BASE))
/* number tests */
@@ -1048,14 +1040,14 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm)
#error "fix yer arch, like"
#endif
-#define _unchecked_make_cp(x) ((Eterm) COMPRESS_POINTER(x))
+#define _unchecked_make_cp(x) ((Eterm)(x))
_ET_DECLARE_CHECKED(Eterm,make_cp,BeamInstr*)
#define make_cp(x) _ET_APPLY(make_cp,(x))
#define is_not_CP(x) ((x) & _CPMASK)
#define is_CP(x) (!is_not_CP(x))
-#define _unchecked_cp_val(x) ((BeamInstr*) EXPAND_POINTER(x))
+#define _unchecked_cp_val(x) ((BeamInstr*) (x))
_ET_DECLARE_CHECKED(BeamInstr*,cp_val,Eterm)
#define cp_val(x) _ET_APPLY(cp_val,(x))
@@ -1071,44 +1063,40 @@ _ET_DECLARE_CHECKED(Uint,catch_val,Eterm)
/*
* Overloaded tags.
*
- * SMALL = 15
- * ATOM/NIL=7
+ * In the loader, we want to tag a term in a way so that it can
+ * be any literal (atom/integer/float/tuple/list/binary) or a
+ * register.
*
- * Note that the two least significant bits in SMALL/ATOM/NIL always are 3;
- * thus, we can distinguish register from literals by looking at only these
- * two bits.
+ * We can achive that by overloading the PID and PORT tags to
+ * mean X and Y registers. That works because there are no
+ * pid or port literals.
*/
-#define X_REG_DEF 0
-#define Y_REG_DEF 1
-#define R_REG_DEF 2
+#define _LOADER_TAG_XREG _TAG_IMMED1_PID
+#define _LOADER_TAG_YREG _TAG_IMMED1_PORT
+#define _LOADER_TAG_SIZE _TAG_IMMED1_SIZE
+#define _LOADER_MASK _TAG_IMMED1_MASK
-#define beam_reg_tag(x) ((x) & 3)
+#define LOADER_X_REG _LOADER_TAG_XREG
+#define LOADER_Y_REG _LOADER_TAG_YREG
-#define make_rreg() R_REG_DEF
-#define make_xreg(ix) (((ix) * sizeof(Eterm)) | X_REG_DEF)
-#define make_yreg(ix) (((ix) * sizeof(Eterm)) | Y_REG_DEF)
+#define make_loader_x_reg(R) (((R) << _LOADER_TAG_SIZE) | _LOADER_TAG_XREG)
+#define make_loader_y_reg(R) (((R) << _LOADER_TAG_SIZE) | _LOADER_TAG_YREG)
-#define _is_xreg(x) (beam_reg_tag(x) == X_REG_DEF)
-#define _is_yreg(x) (beam_reg_tag(x) == Y_REG_DEF)
+#define loader_reg_index(R) ((R) >> _LOADER_TAG_SIZE)
-#define _unchecked_x_reg_offset(R) ((R) - X_REG_DEF)
-_ET_DECLARE_CHECKED(Uint,x_reg_offset,Uint)
-#define x_reg_offset(R) _ET_APPLY(x_reg_offset,(R))
+#define loader_tag(T) ((T) & _LOADER_MASK)
-#define _unchecked_y_reg_offset(R) ((R) - Y_REG_DEF)
-_ET_DECLARE_CHECKED(Uint,y_reg_offset,Uint)
-#define y_reg_offset(R) _ET_APPLY(y_reg_offset,(R))
+#define _is_loader_x_reg(x) (loader_tag(x) == _LOADER_TAG_XREG)
+#define _is_loader_y_reg(x) (loader_tag(x) == _LOADER_TAG_YREG)
-#define reg_index(R) ((R) / sizeof(Eterm))
+#define _unchecked_loader_x_reg_index(R) ((R) >> _LOADER_TAG_SIZE)
+_ET_DECLARE_CHECKED(Uint,loader_x_reg_index,Uint)
+#define loader_x_reg_index(R) _ET_APPLY(loader_x_reg_index,(R))
-#define _unchecked_x_reg_index(R) ((R) >> 2)
-_ET_DECLARE_CHECKED(Uint,x_reg_index,Uint)
-#define x_reg_index(R) _ET_APPLY(x_reg_index,(R))
-
-#define _unchecked_y_reg_index(R) ((R) >> 2)
-_ET_DECLARE_CHECKED(Uint,y_reg_index,Uint)
-#define y_reg_index(R) _ET_APPLY(y_reg_index,(R))
+#define _unchecked_loader_y_reg_index(R) ((R) >> _LOADER_TAG_SIZE)
+_ET_DECLARE_CHECKED(Uint,loader_y_reg_index,Uint)
+#define loader_y_reg_index(R) _ET_APPLY(loader_y_reg_index,(R))
/*
* Backwards compatibility definitions:
@@ -1160,82 +1148,9 @@ extern unsigned tag_val_def(Wterm);
#define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF)
#define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF)
-#if HALFWORD_HEAP
-#define ptr2rel(PTR,BASE) ((Eterm*)((char*)(PTR) - (char*)(BASE)))
-#define rterm2wterm(REL,BASE) ((Wterm)(REL) + (Wterm)(BASE))
-
-#else /* HALFWORD_HEAP */
-
-#define ptr2rel(PTR,BASE) (PTR)
-#define rterm2wterm(REL,BASE) (REL)
-
-#endif /* !HALFWORD_HEAP */
-
-#define make_list_rel(PTR, BASE) make_list(ptr2rel(PTR,BASE))
-#define make_boxed_rel(PTR, BASE) make_boxed(ptr2rel(PTR,BASE))
-#define make_fun_rel make_boxed_rel
-#define make_binary_rel make_boxed_rel
-#define make_tuple_rel make_boxed_rel
-#define make_external_rel make_boxed_rel
-#define make_internal_ref_rel make_boxed_rel
-#define make_big_rel make_boxed_rel
-
-#define binary_val_rel(RTERM, BASE) binary_val(rterm2wterm(RTERM, BASE))
-#define list_val_rel(RTERM, BASE) list_val(rterm2wterm(RTERM, BASE))
-#define boxed_val_rel(RTERM, BASE) boxed_val(rterm2wterm(RTERM, BASE))
-#define tuple_val_rel(RTERM, BASE) tuple_val(rterm2wterm(RTERM, BASE))
-#define export_val_rel(RTERM, BASE) export_val(rterm2wterm(RTERM, BASE))
-#define fun_val_rel(RTERM, BASE) fun_val(rterm2wterm(RTERM, BASE))
-#define big_val_rel(RTERM,BASE) big_val(rterm2wterm(RTERM,BASE))
-#define float_val_rel(RTERM,BASE) float_val(rterm2wterm(RTERM,BASE))
-#define internal_ref_val_rel(RTERM,BASE) internal_ref_val(rterm2wterm(RTERM,BASE))
-
-#define external_thing_ptr_rel(RTERM, BASE) external_thing_ptr(rterm2wterm(RTERM, BASE))
-#define external_data_words_rel(RTERM,BASE) external_data_words(rterm2wterm(RTERM,BASE))
-
-#define external_port_node_rel(RTERM,BASE) external_port_node(rterm2wterm(RTERM,BASE))
-#define external_port_data_rel(RTERM,BASE) external_port_data(rterm2wterm(RTERM,BASE))
-
-#define is_external_pid_rel(RTERM,BASE) is_external_pid(rterm2wterm(RTERM,BASE))
-#define external_pid_node_rel(RTERM,BASE) external_pid_node(rterm2wterm(RTERM,BASE))
-#define external_pid_data_rel(RTERM,BASE) external_pid_data(rterm2wterm(RTERM,BASE))
+#define is_same(A,B) ((A)==(B))
-#define is_binary_rel(RTERM,BASE) is_binary(rterm2wterm(RTERM,BASE))
-#define is_float_rel(RTERM,BASE) is_float(rterm2wterm(RTERM,BASE))
-#define is_fun_rel(RTERM,BASE) is_fun(rterm2wterm(RTERM,BASE))
-#define is_big_rel(RTERM,BASE) is_big(rterm2wterm(RTERM,BASE))
-#define is_export_rel(RTERM,BASE) is_export(rterm2wterm(RTERM,BASE))
-#define is_tuple_rel(RTERM,BASE) is_tuple(rterm2wterm(RTERM,BASE))
-
-#define GET_DOUBLE_REL(RTERM, f, BASE) GET_DOUBLE(rterm2wterm(RTERM,BASE), f)
-
-#define ref_thing_ptr_rel(RTERM,BASE) ref_thing_ptr(rterm2wterm(RTERM,BASE))
-#define is_internal_ref_rel(RTERM,BASE) is_internal_ref(rterm2wterm(RTERM,BASE))
-#define is_external_rel(RTERM,BASE) is_external(rterm2wterm(RTERM,BASE))
-#define is_external_port_rel(RTERM,BASE) is_external_port(rterm2wterm(RTERM,BASE))
-#define is_external_ref_rel(RTERM,BASE) is_external_ref(rterm2wterm(RTERM,BASE))
-
-#define external_node_rel(RTERM,BASE) external_node(rterm2wterm(RTERM,BASE))
-
-
-#if HALFWORD_HEAP
-ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base)
-{
- /* If bases differ, assume a and b are on different "heaps",
- ie can only be same if immed */
- ASSERT(a_base == b_base || is_immed(a) || is_immed(b)
- || rterm2wterm(a,a_base) != rterm2wterm(b,b_base));
-
- return a == b && (a_base == b_base || is_immed(a));
-}
-#endif
-
-#else /* !HALFWORD_HEAP */
-#define is_same(A,A_BASE,B,B_BASE) ((A)==(B))
-#endif
+void erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz);
#endif /* __ERL_TERM_H */
diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h
index 34f91e2ec8..e689547d1d 100644
--- a/erts/emulator/beam/erl_threads.h
+++ b/erts/emulator/beam/erl_threads.h
@@ -2056,6 +2056,8 @@ erts_atomic64_read_dirty(erts_atomic64_t *var)
#endif /* !USE_THREADS */
+#include "erl_msacc.h"
+
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE void
@@ -2414,6 +2416,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx)
{
#ifdef USE_THREADS
int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_unlock(&mtx->lc);
#endif
@@ -2432,6 +2435,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx)
#endif
if (res != 0 && res != EINTR)
erts_thr_fatal_error(res, "wait on condition variable");
+ ERTS_MSACC_POP_STATE();
#endif
}
@@ -3488,7 +3492,11 @@ ERTS_GLB_INLINE void erts_tse_reset(erts_tse_t *ep)
ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep)
{
#ifdef USE_THREADS
- return ethr_event_wait(&((ethr_ts_event *) ep)->event);
+ int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
+ res = ethr_event_wait(&((ethr_ts_event *) ep)->event);
+ ERTS_MSACC_POP_STATE();
+ return res;
#else
return ENOTSUP;
#endif
@@ -3497,7 +3505,11 @@ ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep)
ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount)
{
#ifdef USE_THREADS
- return ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount);
+ int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
+ res = ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount);
+ ERTS_MSACC_POP_STATE();
+ return res;
#else
return ENOTSUP;
#endif
@@ -3506,8 +3518,12 @@ ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount)
ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo)
{
#ifdef USE_THREADS
- return ethr_event_twait(&((ethr_ts_event *) ep)->event,
- (ethr_sint64_t) tmo);
+ int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
+ res = ethr_event_twait(&((ethr_ts_event *) ep)->event,
+ (ethr_sint64_t) tmo);
+ ERTS_MSACC_POP_STATE();
+ return res;
#else
return ENOTSUP;
#endif
@@ -3516,9 +3532,13 @@ ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo)
ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo)
{
#ifdef USE_THREADS
- return ethr_event_stwait(&((ethr_ts_event *) ep)->event,
- spincount,
- (ethr_sint64_t) tmo);
+ int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
+ res = ethr_event_stwait(&((ethr_ts_event *) ep)->event,
+ spincount,
+ (ethr_sint64_t) tmo);
+ ERTS_MSACC_POP_STATE();
+ return res;
#else
return ENOTSUP;
#endif
diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h
index 93a0d556bf..5242063550 100644
--- a/erts/emulator/beam/erl_time.h
+++ b/erts/emulator/beam/erl_time.h
@@ -142,6 +142,8 @@ erts_time_unit_conversion(Uint64 value,
Uint32 from_time_unit,
Uint32 to_time_unit);
+ErtsSysPerfCounter erts_perf_counter_unit(void);
+
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE Uint64
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index 5f12c7809a..98159fdf72 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -1749,7 +1749,7 @@ erts_get_monotonic_time(ErtsSchedulerData *esdp)
{
ErtsMonotonicTime mtime = time_sup.r.o.get_time();
update_last_mtime(esdp, mtime);
- return mtime;
+ return mtime;
}
ErtsMonotonicTime
@@ -1957,15 +1957,16 @@ send_time_offset_changed_notifications(void *new_offsetp)
ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
if (erts_lookup_monitor(ERTS_P_MONITORS(rp), ref)) {
- ErlHeapFragment *bp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
Eterm message;
- hp = erts_alloc_message_heap(hsz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks,
+ hsz, &hp, &ohp);
*patch_refp = ref;
ASSERT(hsz == size_object(message_template));
message = copy_struct(message_template, hsz, &hp, ohp);
- erts_queue_message(rp, &rp_locks, bp, message, NIL);
+ erts_queue_message(rp, &rp_locks, mp, message, NIL);
}
erts_smp_proc_unlock(rp, rp_locks);
}
@@ -2434,9 +2435,19 @@ BIF_RETTYPE os_system_time_0(BIF_ALIST_0)
BIF_RET(make_time_val(BIF_P, stime));
}
-BIF_RETTYPE os_system_time_1(BIF_ALIST_0)
+BIF_RETTYPE os_system_time_1(BIF_ALIST_1)
{
ErtsSystemTime stime = erts_os_system_time();
BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, stime, 0));
}
+BIF_RETTYPE
+os_perf_counter_0(BIF_ALIST_0)
+{
+ BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter()));
+}
+
+BIF_RETTYPE erts_internal_perf_counter_unit_0(BIF_ALIST_0)
+{
+ BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter_unit()));
+}
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 8a4c0ab1f2..25393369a7 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -373,15 +373,10 @@ void erts_init_trace(void) {
static Eterm system_seq_tracer;
-#ifdef ERTS_SMP
#define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, UNUSED) \
(*(BPP) = new_message_buffer((SZ)), \
*(OHPP) = &(*(BPP))->off_heap, \
(*(BPP))->mem)
-#else
-#define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, RPP) \
- erts_alloc_message_heap((SZ), (BPP), (OHPP), (RPP), 0)
-#endif
#ifdef ERTS_SMP
#define ERTS_ENQ_TRACE_MSG(FPID, TPID, MSG, BP) \
@@ -390,8 +385,12 @@ do { \
enqueue_sys_msg_unlocked(SYS_MSG_TYPE_TRACE, (FPID), (TPID), (MSG), (BP)); \
} while(0)
#else
-#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \
- erts_queue_message((TPROC), NULL, (BP), (MSG), NIL)
+#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \
+ do { \
+ ErtsMessage *mp__ = erts_alloc_message(0, NULL); \
+ mp__->data.heap_frag = (BP); \
+ erts_queue_message((TPROC), NULL, mp__, (MSG), NIL); \
+ } while (0)
#endif
/*
@@ -826,11 +825,9 @@ send_to_port(Process *c_p, Eterm message,
static void
profile_send(Eterm from, Eterm message) {
Uint sz = 0;
- ErlHeapFragment *bp = NULL;
Uint *hp = NULL;
Eterm msg = NIL;
Process *profile_p = NULL;
- ErlOffHeap *off_heap = NULL;
Eterm profiler = erts_get_system_profile();
@@ -856,6 +853,7 @@ profile_send(Eterm from, Eterm message) {
}
} else {
+ ErtsMessage *mp;
ASSERT(is_internal_pid(profiler));
profile_p = erts_proc_lookup(profiler);
@@ -864,10 +862,13 @@ profile_send(Eterm from, Eterm message) {
return;
sz = size_object(message);
- hp = erts_alloc_message_heap(sz, &bp, &off_heap, profile_p, 0);
- msg = copy_struct(message, sz, &hp, &bp->off_heap);
-
- erts_queue_message(profile_p, NULL, bp, msg, NIL);
+ mp = erts_alloc_message(sz, &hp);
+ if (sz == 0)
+ msg = message;
+ else
+ msg = copy_struct(message, sz, &hp, &mp->hfrag.off_heap);
+
+ erts_queue_message(profile_p, NULL, mp, msg, NIL);
}
}
@@ -1235,11 +1236,7 @@ seq_trace_update_send(Process *p)
{
Eterm seq_tracer = erts_get_system_seq_tracer();
ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p))));
- if ( (p->common.id == seq_tracer) || (SEQ_TRACE_TOKEN(p) == NIL)
-#ifdef USE_VM_PROBES
- || (SEQ_TRACE_TOKEN(p) == am_have_dt_utag)
-#endif
- ) {
+ if ((p->common.id == seq_tracer) || have_no_seqtrace(SEQ_TRACE_TOKEN(p))) {
return 0;
}
SEQ_TRACE_TOKEN_SENDER(p) = p->common.id;
@@ -1431,7 +1428,11 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
erts_smp_mtx_unlock(&smq_mtx);
#else
/* trace_token must be NIL here */
- erts_queue_message(tracer, NULL, bp, mess, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(tracer, NULL, mp, mess, NIL);
+ }
#endif
}
}
@@ -1851,12 +1852,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags);
if (is_internal_port(*tracer_pid)) {
-#if HEAP_ON_C_STACK
- Eterm local_heap[60+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG];
-#else
- Eterm *local_heap = erts_alloc(ERTS_ALC_T_TEMP_TERM,
- sizeof(Eterm)*(60+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG));
-#endif
+ Eterm local_heap[64+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG];
hp = local_heap;
if (!erts_is_valid_tracer_port(*tracer_pid)) {
@@ -1871,9 +1867,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
if (is_not_nil(tracee))
erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
#endif
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return 0;
}
@@ -1901,9 +1894,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
ERTS_PAM_TMP_RESULT, &return_flags);
if (is_non_value(pam_result)) {
erts_match_set_release_result(p);
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return 0;
}
@@ -1912,9 +1902,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
/* Meta trace */
if (pam_result == am_false) {
erts_match_set_release_result(p);
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return return_flags;
}
@@ -1922,17 +1909,11 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
/* Non-meta trace */
if (*tracee_flags & F_TRACE_SILENT) {
erts_match_set_release_result(p);
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return 0;
}
if (pam_result == am_false) {
erts_match_set_release_result(p);
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return return_flags;
}
@@ -1974,9 +1955,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
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;
@@ -2314,11 +2292,6 @@ void save_calls(Process *p, Export *e)
void
trace_gc(Process *p, Eterm what)
{
- ERTS_DECL_AM(bin_vheap_size);
- ERTS_DECL_AM(bin_vheap_block_size);
- ERTS_DECL_AM(bin_old_vheap_size);
- ERTS_DECL_AM(bin_old_vheap_block_size);
-
ErlHeapFragment *bp = NULL;
ErlOffHeap *off_heap;
ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; /* Initialized
@@ -2329,52 +2302,19 @@ trace_gc(Process *p, Eterm what)
Eterm msg = NIL;
Uint size;
- Eterm tags[] = {
- am_old_heap_block_size,
- am_heap_block_size,
- am_mbuf_size,
- am_recent_size,
- am_stack_size,
- am_old_heap_size,
- am_heap_size,
- AM_bin_vheap_size,
- AM_bin_vheap_block_size,
- AM_bin_old_vheap_size,
- AM_bin_old_vheap_block_size
- };
-
- UWord values[] = {
- OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0,
- HEAP_SIZE(p),
- MBUF_SIZE(p),
- HIGH_WATER(p) - HEAP_START(p),
- STACK_START(p) - p->stop,
- OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0,
- HEAP_TOP(p) - HEAP_START(p),
- MSO(p).overhead,
- BIN_VHEAP_SZ(p),
- BIN_OLD_VHEAP(p),
- BIN_OLD_VHEAP_SZ(p)
- };
#define LOCAL_HEAP_SIZE \
- (sizeof(values)/sizeof(*values)) * \
- (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE) + \
+ (ERTS_PROCESS_GC_INFO_MAX_SIZE) + \
5/*4-tuple */ + ERTS_TRACE_PATCH_TS_MAX_SIZE
DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p);
- ERTS_CT_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);
+ (void) erts_process_gc_info(p, &size, NULL);
+
size += 5/*4-tuple*/ + PATCH_TS_SIZE(p);
#endif
} else {
@@ -2385,11 +2325,8 @@ trace_gc(Process *p, Eterm what)
ERTS_TRACE_FLAGS(p));
size = 0;
- (void) erts_bld_atom_uword_2tup_list(NULL,
- &size,
- sizeof(values)/sizeof(*values),
- tags,
- values);
+ (void) erts_process_gc_info(p, &size, NULL);
+
size += 5/*4-tuple*/ + PATCH_TS_SIZE(p);
hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
@@ -2397,11 +2334,7 @@ trace_gc(Process *p, Eterm what)
ASSERT(size <= LOCAL_HEAP_SIZE);
- msg = erts_bld_atom_uword_2tup_list(&hp,
- NULL,
- sizeof(values)/sizeof(*values),
- tags,
- values);
+ msg = erts_process_gc_info(p, NULL, &hp);
msg = TUPLE4(hp, am_trace, p->common.id, what, msg);
hp += 5;
@@ -2477,7 +2410,11 @@ monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
void
@@ -2538,7 +2475,11 @@ monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time)
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
@@ -2609,7 +2550,11 @@ monitor_long_gc(Process *p, Uint time) {
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
@@ -2680,7 +2625,11 @@ monitor_large_heap(Process *p) {
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
@@ -2708,7 +2657,11 @@ monitor_generic(Process *p, Eterm type, Eterm spec) {
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
@@ -3436,8 +3389,6 @@ sys_msg_dispatcher_func(void *unused)
if (erts_thr_progress_update(NULL))
erts_thr_progress_leader_update(NULL);
- ERTS_SCHED_FAIR_YIELD();
-
#ifdef DEBUG_PRINTOUTS
print_msg_type(smqp);
#endif
@@ -3496,8 +3447,11 @@ sys_msg_dispatcher_func(void *unused)
goto failure;
}
else {
+ ErtsMessage *mp;
queue_proc_msg:
- erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL);
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = smqp->bp;
+ erts_queue_message(proc,&proc_locks,mp,smqp->msg,NIL);
#ifdef DEBUG_PRINTOUTS
erts_fprintf(stderr, "delivered\n");
#endif
@@ -3592,9 +3546,6 @@ static void
init_sys_msg_dispatcher(void)
{
erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER;
-#ifdef __OSE__
- thr_opts.coreNo = 0;
-#endif
thr_opts.detached = 1;
thr_opts.name = "sys_msg_dispatcher";
init_smq_element_alloc();
@@ -3602,7 +3553,6 @@ init_sys_msg_dispatcher(void)
sys_message_queue_end = NULL;
erts_smp_cnd_init(&smq_cnd);
erts_smp_mtx_init(&smq_mtx, "sys_msg_q");
-
erts_smp_thr_create(&sys_msg_dispatcher_tid,
sys_msg_dispatcher_func,
NULL,
diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h
index 6dab3bf297..640969daf0 100644
--- a/erts/emulator/beam/erl_utils.h
+++ b/erts/emulator/beam/erl_utils.h
@@ -115,7 +115,7 @@ void erts_silence_warn_unused_result(long unused);
int erts_fit_in_bits_int64(Sint64);
int erts_fit_in_bits_int32(Sint32);
int erts_fit_in_bits_uint(Uint);
-int erts_list_length(Eterm);
+Sint erts_list_length(Eterm);
int erts_is_builtin(Eterm, Eterm, int);
Uint32 make_broken_hash(Eterm);
Uint32 block_hash(byte *, unsigned, Uint32);
@@ -157,51 +157,46 @@ void erts_init_utils_mem(void);
erts_dsprintf_buf_t *erts_create_tmp_dsbuf(Uint);
void erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *);
-#if HALFWORD_HEAP
-int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base);
-# define eq(A,B) eq_rel(A,NULL,B,NULL)
-#else
int eq(Eterm, Eterm);
-# define eq_rel(A,A_BASE,B,B_BASE) eq(A,B)
-#endif
#define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y))))
-#if HALFWORD_HEAP
-Sint erts_cmp_rel_opt(Eterm, Eterm*, Eterm, Eterm*, int, int);
-#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,0,0)
-#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,1,0)
-#define CMP(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0,0)
-#define CMP_TERM(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,1,0)
-#define CMP_EQ_ONLY(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0,1)
-#else
+int erts_cmp_atoms(Eterm a, Eterm b);
Sint erts_cmp(Eterm, Eterm, int, int);
+Sint erts_cmp_compound(Eterm, Eterm, int, int);
Sint cmp(Eterm a, Eterm b);
-#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp(A,B,0,0)
-#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp(A,B,1,0)
#define CMP(A,B) erts_cmp(A,B,0,0)
#define CMP_TERM(A,B) erts_cmp(A,B,1,0)
#define CMP_EQ_ONLY(A,B) erts_cmp(A,B,0,1)
-#endif
-#define cmp_lt(a,b) (CMP((a),(b)) < 0)
-#define cmp_le(a,b) (CMP((a),(b)) <= 0)
-#define cmp_eq(a,b) (CMP_EQ_ONLY((a),(b)) == 0)
-#define cmp_ne(a,b) (CMP_EQ_ONLY((a),(b)) != 0)
-#define cmp_ge(a,b) (CMP((a),(b)) >= 0)
-#define cmp_gt(a,b) (CMP((a),(b)) > 0)
-
-#define cmp_lt_term(a,b) (CMP_TERM((a),(b)) < 0)
-#define cmp_le_term(a,b) (CMP_TERM((a),(b)) <= 0)
-#define cmp_ge_term(a,b) (CMP_TERM((a),(b)) >= 0)
-#define cmp_gt_term(a,b) (CMP_TERM((a),(b)) > 0)
-
-#define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b)))
-#define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b)))
-#define CMP_EQ(a,b) ((a) == (b) || cmp_eq((a),(b)))
-#define CMP_NE(a,b) ((a) != (b) && cmp_ne((a),(b)))
-
-#define CMP_LT_TERM(a,b) ((a) != (b) && cmp_lt_term((a),(b)))
-#define CMP_GE_TERM(a,b) ((a) == (b) || cmp_ge_term((a),(b)))
+#define CMP_LT(a,b) ((a) != (b) && CMP((a),(b)) < 0)
+#define CMP_LE(a,b) ((a) == (b) || CMP((a),(b)) <= 0)
+#define CMP_EQ(a,b) ((a) == (b) || CMP_EQ_ONLY((a),(b)) == 0)
+#define CMP_NE(a,b) ((a) != (b) && CMP_EQ_ONLY((a),(b)) != 0)
+#define CMP_GE(a,b) ((a) == (b) || CMP((a),(b)) >= 0)
+#define CMP_GT(a,b) ((a) != (b) && CMP((a),(b)) > 0)
+
+#define CMP_EQ_ACTION(X,Y,Action) \
+ if ((X) != (Y)) { CMP_SPEC((X),(Y),!=,Action,1); }
+#define CMP_NE_ACTION(X,Y,Action) \
+ if ((X) == (Y)) { Action; } else { CMP_SPEC((X),(Y),==,Action,1); }
+#define CMP_GE_ACTION(X,Y,Action) \
+ if ((X) != (Y)) { CMP_SPEC((X),(Y),<,Action,0); }
+#define CMP_LT_ACTION(X,Y,Action) \
+ if ((X) == (Y)) { Action; } else { CMP_SPEC((X),(Y),>=,Action,0); }
+
+#define CMP_SPEC(X,Y,Op,Action,EqOnly) \
+ if (is_atom(X) && is_atom(Y)) { \
+ if (erts_cmp_atoms(X, Y) Op 0) { Action; }; \
+ } else if (is_both_small(X, Y)) { \
+ if (signed_val(X) Op signed_val(Y)) { Action; }; \
+ } else if (is_float(X) && is_float(Y)) { \
+ FloatDef af, bf; \
+ GET_DOUBLE(X, af); \
+ GET_DOUBLE(Y, bf); \
+ if (af.fd Op bf.fd) { Action; }; \
+ } else { \
+ if (erts_cmp_compound(X,Y,0,EqOnly) Op 0) { Action; }; \
+ }
#endif
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 8948ca2ea9..98f27a1725 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -40,14 +40,6 @@
#define MAX_ARG 255 /* Max number of arguments allowed */
#define MAX_REG 1024 /* Max number of x(N) registers used */
-/* Scheduler stores data for temporary heaps if
- !HEAP_ON_C_STACK. Macros (*TmpHeap*) in global.h selects if we put temporary
- heap data on the C stack or if we use the buffers in the scheduler data. */
-#define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers
- small heap for transient heap data */
-#define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */
-#define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */
-
/*
* The new arithmetic operations need some extra X registers in the register array.
* so does the gc_bif's (i_gc_bif3 need 3 extra).
@@ -117,12 +109,8 @@
#define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p))
#if defined(DEBUG) || defined(CHECK_FOR_HOLES)
-#if HALFWORD_HEAP
-# define ERTS_HOLE_MARKER (0xdeadbeef)
-#else
# define ERTS_HOLE_MARKER (((0xdeadbeef << 24) << 8) | 0xdeadbeef)
-#endif
-#endif
+#endif /* egil: 32-bit ? */
/*
* Allocate heap memory on the ordinary heap, NEVER in a heap
@@ -153,6 +141,7 @@
typedef struct op_entry {
char* name; /* Name of instruction. */
Uint32 mask[3]; /* Signature mask. */
+ unsigned involves_r; /* Needs special attention when matching. */
int sz; /* Number of loaded words. */
char* pack; /* Instructions for packing engine. */
char* sign; /* Signature string. */
diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c
index 2420df36b5..581efe6eec 100644
--- a/erts/emulator/beam/export.c
+++ b/erts/emulator/beam/export.c
@@ -184,6 +184,9 @@ init_export_table(void)
f.cmp = (HCMP_FUN) export_cmp;
f.alloc = (HALLOC_FUN) export_alloc;
f.free = (HFREE_FUN) export_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
for (i=0; i<ERTS_NUM_CODE_IX; i++) {
erts_index_init(ERTS_ALC_T_EXPORT_TABLE, &export_tables[i], "export_list",
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index a85aa15403..58010dcb72 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -2339,10 +2339,6 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
Eterm val;
FloatDef f;
Sint r = 0;
-#if HALFWORD_HEAP
- UWord wobj;
-#endif
-
if (ctx) {
WSTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
@@ -2362,11 +2358,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
outer_loop:
while (!WSTACK_ISEMPTY(s)) {
-#if HALFWORD_HEAP
- obj = (Eterm) (wobj = WSTACK_POP(s));
-#else
obj = WSTACK_POP(s);
-#endif
+
switch (val = WSTACK_POP(s)) {
case ENC_TERM:
break;
@@ -2384,11 +2377,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
break;
case ENC_PATCH_FUN_SIZE:
{
-#if HALFWORD_HEAP
- byte* size_p = (byte *) wobj;
-#else
byte* size_p = (byte *) obj;
-#endif
put_int32(ep - size_p, size_p);
}
goto outer_loop;
@@ -2435,21 +2424,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
case ENC_LAST_ARRAY_ELEMENT:
/* obj is the tuple */
{
-#if HALFWORD_HEAP
- Eterm* ptr = (Eterm *) wobj;
-#else
Eterm* ptr = (Eterm *) obj;
-#endif
obj = *ptr;
}
break;
default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */
{
-#if HALFWORD_HEAP
- Eterm* ptr = (Eterm *) wobj;
-#else
Eterm* ptr = (Eterm *) obj;
-#endif
obj = *ptr++;
WSTACK_PUSH2(s, val-1, (UWord)ptr);
}
@@ -2976,7 +2957,7 @@ dec_term(ErtsDistExternal *edep,
case B2TDecodeList:
objp = next - 2;
while (n > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
objp[1] = make_list(next);
next = objp;
objp -= 2;
@@ -2987,7 +2968,7 @@ dec_term(ErtsDistExternal *edep,
case B2TDecodeTuple:
objp = next - 1;
while (n-- > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
next = objp;
objp--;
}
@@ -3043,7 +3024,7 @@ dec_term(ErtsDistExternal *edep,
while (next != NULL) {
objp = next;
- next = (Eterm *) EXPAND_POINTER(*objp);
+ next = (Eterm *) *objp;
switch (*ep++) {
case INTEGER_EXT:
@@ -3051,7 +3032,7 @@ dec_term(ErtsDistExternal *edep,
Sint sn = get_int32(ep);
ep += 4;
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
*objp = make_small(sn);
#else
if (MY_IS_SSMALL(sn)) {
@@ -3174,7 +3155,7 @@ dec_term_atom_common:
reds -= n;
}
while (n-- > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
next = objp;
objp--;
}
@@ -3192,8 +3173,8 @@ dec_term_atom_common:
*objp = make_list(hp);
hp += 2 * n;
objp = hp - 2;
- objp[0] = (Eterm) COMPRESS_POINTER((objp+1));
- objp[1] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) (objp+1);
+ objp[1] = (Eterm) next;
next = objp;
objp -= 2;
n--;
@@ -3206,7 +3187,7 @@ dec_term_atom_common:
reds -= n;
}
while (n > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
objp[1] = make_list(next);
next = objp;
objp -= 2;
@@ -3373,7 +3354,7 @@ dec_term_atom_common:
RefThing *rtp = (RefThing *) hp;
ref_num = (Uint32 *) (hp + REF_THING_HEAD_SIZE);
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
hp += REF_THING_HEAD_SIZE + ref_words/2 + 1;
rtp->header = make_ref_thing_header(ref_words/2 + 1);
#else
@@ -3384,13 +3365,13 @@ dec_term_atom_common:
}
else {
ExternalThing *etp = (ExternalThing *) hp;
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
hp += EXTERNAL_THING_HEAD_SIZE + ref_words/2 + 1;
#else
hp += EXTERNAL_THING_HEAD_SIZE + ref_words;
#endif
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
etp->header = make_external_ref_header(ref_words/2 + 1);
#else
etp->header = make_external_ref_header(ref_words);
@@ -3403,7 +3384,7 @@ dec_term_atom_common:
ref_num = &(etp->data.ui32[0]);
}
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
*(ref_num++) = ref_words /* 32-bit arity */;
#endif
ref_num[0] = r0;
@@ -3411,7 +3392,7 @@ dec_term_atom_common:
ref_num[i] = get_int32(ep);
ep += 4;
}
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if ((1 + ref_words) % 2)
ref_num[ref_words] = 0;
#endif
@@ -3563,12 +3544,7 @@ dec_term_atom_common:
}
*objp = make_export(hp);
*hp++ = HEADER_EXPORT;
-#if HALFWORD_HEAP
- *((UWord *) (UWord) hp) = (UWord) erts_export_get_or_make_stub(mod, name, arity);
- hp += 2;
-#else
*hp++ = (Eterm) erts_export_get_or_make_stub(mod, name, arity);
-#endif
break;
}
break;
@@ -3604,8 +3580,8 @@ dec_term_atom_common:
*objp = make_flatmap(mp);
for (n = size; n; n--) {
- *vptr = (Eterm) COMPRESS_POINTER(next);
- *kptr = (Eterm) COMPRESS_POINTER(vptr);
+ *vptr = (Eterm) next;
+ *kptr = (Eterm) vptr;
next = kptr;
vptr--;
kptr--;
@@ -3619,8 +3595,8 @@ dec_term_atom_common:
hamt->leaf_array = hp;
for (n = size; n; n--) {
- CDR(hp) = (Eterm) COMPRESS_POINTER(next);
- CAR(hp) = (Eterm) COMPRESS_POINTER(&CDR(hp));
+ CDR(hp) = (Eterm) next;
+ CAR(hp) = (Eterm) &CDR(hp);
next = &CAR(hp);
hp += 2;
}
@@ -3697,11 +3673,11 @@ dec_term_atom_common:
/* Environment */
for (i = num_free-1; i >= 0; i--) {
- funp->env[i] = (Eterm) COMPRESS_POINTER(next);
+ funp->env[i] = (Eterm) next;
next = funp->env + i;
}
/* Creator */
- funp->creator = (Eterm) COMPRESS_POINTER(next);
+ funp->creator = (Eterm) next;
next = &(funp->creator);
break;
}
@@ -3770,7 +3746,7 @@ dec_term_atom_common:
/* Environment */
for (i = num_free-1; i >= 0; i--) {
- funp->env[i] = (Eterm) COMPRESS_POINTER(next);
+ funp->env[i] = (Eterm) next;
next = funp->env + i;
}
break;
@@ -3897,7 +3873,7 @@ dec_term_atom_common:
}
WSTACK_DESTROY(flat_maps);
- ASSERT((Eterm*)EXPAND_POINTER(*dbg_resultp) != NULL);
+ ASSERT((Eterm*)*dbg_resultp != NULL);
if (ctx) {
ctx->state = B2TDone;
@@ -4190,11 +4166,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
case EXPORT_DEF:
{
Export* ep = *((Export **) (export_val(obj) + 1));
-#if HALFWORD_HEAP
- result += 2;
-#else
result += 1;
-#endif
result += encode_size_struct2(acmp, ep->code[0], dflags);
result += encode_size_struct2(acmp, ep->code[1], dflags);
result += encode_size_struct2(acmp, make_small(ep->code[2]), dflags);
@@ -4309,7 +4281,7 @@ init_done:
switch (tag) {
case INTEGER_EXT:
SKIP(4);
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
heap_size += BIG_UINT_HEAP_SIZE;
#endif
break;
@@ -4398,7 +4370,7 @@ init_done:
ep += 2;
atom_extra_skip = 1 + 4*id_words;
/* In case it is an external ref */
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
heap_size += EXTERNAL_THING_HEAD_SIZE + id_words/2 + 1;
#else
heap_size += EXTERNAL_THING_HEAD_SIZE + id_words;
@@ -4484,11 +4456,7 @@ init_done:
break;
case EXPORT_EXT:
terms += 3;
-#if HALFWORD_HEAP
- heap_size += 3;
-#else
heap_size += 2;
-#endif
break;
case NEW_FUN_EXT:
{
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index ec9296d034..2a8bdb6ee3 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -310,9 +310,6 @@ typedef union {
typedef struct proc_bin {
Eterm thing_word; /* Subtag REFC_BINARY_SUBTAG. */
Uint size; /* Binary size in bytes. */
-#if HALFWORD_HEAP
- void* dummy_ptr_padding__;
-#endif
struct erl_off_heap_header *next;
Binary *val; /* Pointer to Binary structure. */
byte *bytes; /* Pointer to the actual data bytes. */
@@ -383,7 +380,7 @@ extern int bif_reductions; /* reductions + fcalls (when doing call_bif) */
extern int stackdump_on_exit;
/*
- * Here is an implementation of a lightweiht stack.
+ * Here is an implementation of a lightweight stack.
*
* Use it like this:
*
@@ -848,6 +845,94 @@ do {\
} while(0)
+/*
+ * An implementation of lightweight unbounded queues,
+ * using a circular dynamic array.
+ * It does not include support for change_allocator.
+ *
+ * Use it like this:
+ *
+ * DECLARE_EQUEUE(Queue) (At the start of a block)
+ * ...
+ * EQUEUE_PUT(Queue, Term)
+ * ...
+ * if (EQUEUE_ISEMPTY(Queue)) {
+ * Queue is empty
+ * } else {
+ * Term = EQUEUE_GET(Stack);
+ * Process popped Term here
+ * }
+ * ...
+ * DESTROY_EQUEUE(Queue)
+ */
+
+typedef struct {
+ Eterm* start;
+ Eterm* front;
+ Eterm* back;
+ int possibly_empty;
+ Eterm* end;
+ ErtsAlcType_t alloc_type;
+} ErtsEQueue;
+
+#define DEF_EQUEUE_SIZE (16)
+
+void erl_grow_equeue(ErtsEQueue*, Eterm* def_queue);
+#define EQUE_CONCAT(a,b) a##b
+#define EQUE_DEF_QUEUE(q) EQUE_CONCAT(q,_default_equeue)
+
+#define DECLARE_EQUEUE(q) \
+ UWord EQUE_DEF_QUEUE(q)[DEF_EQUEUE_SIZE]; \
+ ErtsEQueue q = { \
+ EQUE_DEF_QUEUE(q), /* start */ \
+ EQUE_DEF_QUEUE(q), /* front */ \
+ EQUE_DEF_QUEUE(q), /* back */ \
+ 1, /* possibly_empty */ \
+ EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }
+
+#define DESTROY_EQUEUE(q) \
+do { \
+ if (q.start != EQUE_DEF_QUEUE(q)) { \
+ erts_free(q.alloc_type, q.start); \
+ } \
+} while(0)
+
+#define EQUEUE_PUT_UNCHECKED(q, x) \
+do { \
+ q.possibly_empty = 0; \
+ *(q.back) = (x); \
+ if (++(q.back) == q.end) { \
+ q.back = q.start; \
+ } \
+} while(0)
+
+#define EQUEUE_PUT(q, x) \
+do { \
+ if (q.back == q.front && !q.possibly_empty) { \
+ erl_grow_equeue(&q, EQUE_DEF_QUEUE(q)); \
+ } \
+ EQUEUE_PUT_UNCHECKED(q, x); \
+} while(0)
+
+#define EQUEUE_ISEMPTY(q) (q.back == q.front && q.possibly_empty)
+
+ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q) {
+ Eterm x;
+ q->possibly_empty = 1;
+ x = *(q->front);
+ if (++(q->front) == q->end) {
+ q->front = q->start;
+ }
+ return x;
+}
+#endif
+#define EQUEUE_GET(q) erts_equeue_get(&(q));
+
/* binary.c */
void erts_emasculate_writable_binary(ProcBin* pb);
@@ -900,8 +985,18 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg);
Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2);
/* beam_bif_load.c */
-Eterm erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp);
+#define ERTS_CPC_ALLOW_GC (1 << 0)
+#define ERTS_CPC_COPY_LITERALS (1 << 1)
+#define ERTS_CPC_ALL (ERTS_CPC_ALLOW_GC | ERTS_CPC_COPY_LITERALS)
+Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp);
+typedef struct {
+ Eterm *ptr;
+ Uint sz;
+ Eterm pid;
+} copy_literals_t;
+
+extern copy_literals_t erts_clrange;
/* beam_load.c */
typedef struct {
@@ -956,35 +1051,71 @@ __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);
-/* copy.c */
-Eterm copy_object(Eterm, Process*);
+/* This controls whether sharing-preserving copy is used by Erlang */
-#if HALFWORD_HEAP
-Uint size_object_rel(Eterm, Eterm*);
-# define size_object(A) size_object_rel(A,NULL)
+#ifdef SHCOPY
+#define SHCOPY_SEND
+#define SHCOPY_SPAWN
+#endif
+
+/* The persistent state while the sharing-preserving copier works */
-Eterm copy_struct_rel(Eterm, Uint, Eterm**, ErlOffHeap*, Eterm* src_base, Eterm* dst_base);
-# define copy_struct(OBJ,SZ,HPP,OH) copy_struct_rel(OBJ,SZ,HPP,OH, NULL,NULL)
+typedef struct {
+ Eterm queue_default[DEF_EQUEUE_SIZE];
+ Eterm* queue_start;
+ Eterm* queue_end;
+ ErtsAlcType_t queue_alloc_type;
+ UWord bitstore_default[DEF_WSTACK_SIZE];
+ UWord* bitstore_start;
+ ErtsAlcType_t bitstore_alloc_type;
+ Eterm shtable_default[DEF_ESTACK_SIZE];
+ Eterm* shtable_start;
+ ErtsAlcType_t shtable_alloc_type;
+ Uint literal_size;
+ Eterm *range_ptr;
+ Uint range_sz;
+} erts_shcopy_t;
+
+#define INITIALIZE_SHCOPY(info) \
+do { \
+ info.queue_start = info.queue_default; \
+ info.bitstore_start = info.bitstore_default; \
+ info.shtable_start = info.shtable_default; \
+ info.literal_size = 0; \
+ info.range_ptr = erts_clrange.ptr; \
+ info.range_sz = erts_clrange.sz; \
+} while(0)
-Eterm copy_shallow_rel(Eterm*, Uint, Eterm**, ErlOffHeap*, Eterm* src_base);
-# define copy_shallow(A,B,C,D) copy_shallow_rel(A,B,C,D,NULL)
+#define DESTROY_SHCOPY(info) \
+do { \
+ if (info.queue_start != info.queue_default) { \
+ erts_free(info.queue_alloc_type, info.queue_start); \
+ } \
+ if (info.bitstore_start != info.bitstore_default) { \
+ erts_free(info.bitstore_alloc_type, info.bitstore_start); \
+ } \
+ if (info.shtable_start != info.shtable_default) { \
+ erts_free(info.shtable_alloc_type, info.shtable_start); \
+ } \
+} while(0)
-#else /* !HALFWORD_HEAP */
+/* copy.c */
+Eterm copy_object_x(Eterm, Process*, Uint);
+#define copy_object(Term, Proc) copy_object_x(Term,Proc,0)
Uint size_object(Eterm);
-# define size_object_rel(A,B) size_object(A)
+Uint copy_shared_calculate(Eterm, erts_shcopy_t*);
+Eterm copy_shared_perform(Eterm, Uint, erts_shcopy_t*, Eterm**, ErlOffHeap*);
-Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*);
-# define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH)
+Uint size_shared(Eterm);
+Eterm copy_struct_x(Eterm, Uint, Eterm**, ErlOffHeap*, Uint* bsz);
+#define copy_struct(Obj,Sz,HPP,OH) \
+ copy_struct_x(Obj,Sz,HPP,OH,NULL)
Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*);
-# define copy_shallow_rel(A,B,C,D, BASE) copy_shallow(A,B,C,D)
-#endif
-
-
-void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first,
- Eterm* refs, unsigned nrefs);
+void erts_move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first,
+ Eterm* refs, unsigned nrefs, int literals);
/* Utilities */
extern void erts_delete_nodes_monitors(Process *, ErtsProcLocks);
@@ -1037,6 +1168,9 @@ extern ErtsModifiedTimings erts_modified_timings[];
extern int erts_no_line_info;
extern Eterm erts_error_logger_warnings;
extern int erts_initialized;
+#if defined(USE_THREADS) && !defined(ERTS_SMP)
+extern erts_tid_t erts_main_thread;
+#endif
extern int erts_compat_rel;
extern int erts_use_sender_punish;
void erts_short_init(void);
@@ -1177,10 +1311,10 @@ int erts_utf8_to_latin1(byte* dest, const byte* source, int slen);
#define ERTS_UTF8_OK_MAX_CHARS 4
void bin_write(int, void*, byte*, size_t);
-int intlist_to_buf(Eterm, char*, int); /* most callers pass plain char*'s */
+Sint intlist_to_buf(Eterm, char*, Sint); /* most callers pass plain char*'s */
struct Sint_buf {
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
char s[22];
#else
char s[12];
@@ -1250,7 +1384,7 @@ ErlDrvSizeT erts_iolist_to_buf(Eterm, char*, ErlDrvSizeT);
ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *);
int erts_iolist_size_yielding(ErtsIOListState *state);
int erts_iolist_size(Eterm, ErlDrvSizeT *);
-int is_string(Eterm);
+Sint is_string(Eterm);
void erl_at_exit(void (*) (void*), void*);
Eterm collect_memory(Process *);
void dump_memory_to_fd(int);
@@ -1296,6 +1430,29 @@ int erts_print_system_version(int to, void *arg, Process *c_p);
int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg);
+ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr)
+{
+ ASSERT(is_boxed(tptr) || is_list(tptr));
+ ASSERT(ptr == ptr_val(tptr));
+
+#if defined(ERTS_HAVE_IS_IN_LITERAL_RANGE)
+ return erts_is_in_literal_range(ptr);
+#elif defined(TAG_LITERAL_PTR)
+ return is_literal_ptr(tptr);
+#else
+# error Not able to detect literals...
+#endif
+
+}
+
+#endif
+
+Eterm erts_msacc_request(Process *c_p, int action, Eterm *threads);
+
/*
** Call_trace uses this API for the parameter matching functions
*/
@@ -1344,191 +1501,21 @@ extern void erts_match_prog_foreach_offheap(Binary *b,
extern erts_driver_t vanilla_driver;
extern erts_driver_t spawn_driver;
+extern erts_driver_t forker_driver;
extern erts_driver_t fd_driver;
int erts_beam_jump_table(void);
-/* Should maybe be placed in erl_message.h, but then we get an include mess. */
-ERTS_GLB_INLINE Eterm *
-erts_alloc_message_heap_state(Uint size,
- ErlHeapFragment **bpp,
- ErlOffHeap **ohpp,
- Process *receiver,
- ErtsProcLocks *receiver_locks,
- erts_aint32_t *statep);
-
-ERTS_GLB_INLINE Eterm *
-erts_alloc_message_heap(Uint size,
- ErlHeapFragment **bpp,
- ErlOffHeap **ohpp,
- Process *receiver,
- ErtsProcLocks *receiver_locks);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-/*
- * NOTE: erts_alloc_message_heap() releases msg q and status
- * lock on receiver without ensuring that other locks are
- * held. User is responsible to ensure that the receiver
- * pointer cannot become invalid until after message has
- * been passed. This is normal done either by increasing
- * reference count on process (preferred) or by holding
- * main or link lock over the whole message passing
- * operation.
- */
-
-ERTS_GLB_INLINE Eterm *
-erts_alloc_message_heap_state(Uint size,
- ErlHeapFragment **bpp,
- ErlOffHeap **ohpp,
- Process *receiver,
- ErtsProcLocks *receiver_locks,
- erts_aint32_t *statep)
-{
- Eterm *hp;
- erts_aint32_t state;
-#ifdef ERTS_SMP
- int locked_main = 0;
- state = erts_smp_atomic32_read_acqb(&receiver->state);
- if (statep)
- *statep = state;
- if (state & (ERTS_PSFLG_EXITING
- | ERTS_PSFLG_PENDING_EXIT))
- goto allocate_in_mbuf;
-#endif
-
- if (size > (Uint) INT_MAX)
- erl_exit(ERTS_ABORT_EXIT, "HUGE size (%beu)\n", size);
-
- if (
-#if defined(ERTS_SMP)
- *receiver_locks & ERTS_PROC_LOCK_MAIN
-#else
- 1
-#endif
- ) {
-#ifdef ERTS_SMP
- try_allocate_on_heap:
-#endif
- state = erts_smp_atomic32_read_nob(&receiver->state);
- if (statep)
- *statep = state;
- if ((state & (ERTS_PSFLG_EXITING
- | ERTS_PSFLG_PENDING_EXIT))
- || (receiver->flags & F_DISABLE_GC)
- || HEAP_LIMIT(receiver) - HEAP_TOP(receiver) <= size) {
- /*
- * The heap is either potentially in an inconsistent
- * state, or not large enough.
- */
-#ifdef ERTS_SMP
- if (locked_main) {
- *receiver_locks &= ~ERTS_PROC_LOCK_MAIN;
- erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MAIN);
- }
-#endif
- goto allocate_in_mbuf;
- }
- hp = HEAP_TOP(receiver);
- HEAP_TOP(receiver) = hp + size;
- *bpp = NULL;
- *ohpp = &MSO(receiver);
- }
-#ifdef ERTS_SMP
- else if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MAIN) == 0) {
- locked_main = 1;
- *receiver_locks |= ERTS_PROC_LOCK_MAIN;
- goto try_allocate_on_heap;
- }
-#endif
- else {
- ErlHeapFragment *bp;
- allocate_in_mbuf:
- bp = new_message_buffer(size);
- hp = bp->mem;
- *bpp = bp;
- *ohpp = &bp->off_heap;
- }
-
- return hp;
-}
-
-ERTS_GLB_INLINE Eterm *
-erts_alloc_message_heap(Uint size,
- ErlHeapFragment **bpp,
- ErlOffHeap **ohpp,
- Process *receiver,
- ErtsProcLocks *receiver_locks)
-{
- return erts_alloc_message_heap_state(size, bpp, ohpp, receiver,
- receiver_locks, NULL);
-}
-
-#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-
-#if !HEAP_ON_C_STACK
-# if defined(DEBUG)
-# define DeclareTmpHeap(VariableName,Size,Process) \
- Eterm *VariableName = erts_debug_allocate_tmp_heap(Size,Process)
-# define DeclareTypedTmpHeap(Type,VariableName,Process) \
- Type *VariableName = (Type *) erts_debug_allocate_tmp_heap(sizeof(Type)/sizeof(Eterm),Process)
-# define DeclareTmpHeapNoproc(VariableName,Size) \
- Eterm *VariableName = erts_debug_allocate_tmp_heap(Size,NULL)
-# define UseTmpHeap(Size,Proc) \
- do { \
- erts_debug_use_tmp_heap((Size),(Proc)); \
- } while (0)
-# define UnUseTmpHeap(Size,Proc) \
- do { \
- erts_debug_unuse_tmp_heap((Size),(Proc)); \
- } while (0)
-# define UseTmpHeapNoproc(Size) \
- do { \
- erts_debug_use_tmp_heap(Size,NULL); \
- } while (0)
-# define UnUseTmpHeapNoproc(Size) \
- do { \
- erts_debug_unuse_tmp_heap(Size,NULL); \
- } while (0)
-# else
-# define DeclareTmpHeap(VariableName,Size,Process) \
- Eterm *VariableName = (ERTS_PROC_GET_SCHDATA(Process)->tmp_heap)+(ERTS_PROC_GET_SCHDATA(Process)->num_tmp_heap_used)
-# define DeclareTypedTmpHeap(Type,VariableName,Process) \
- Type *VariableName = (Type *) (ERTS_PROC_GET_SCHDATA(Process)->tmp_heap)+(ERTS_PROC_GET_SCHDATA(Process)->num_tmp_heap_used)
-# define DeclareTmpHeapNoproc(VariableName,Size) \
- Eterm *VariableName = (erts_get_scheduler_data()->tmp_heap)+(erts_get_scheduler_data()->num_tmp_heap_used)
-# define UseTmpHeap(Size,Proc) \
- do { \
- ERTS_PROC_GET_SCHDATA(Proc)->num_tmp_heap_used += (Size); \
- } while (0)
-# define UnUseTmpHeap(Size,Proc) \
- do { \
- ERTS_PROC_GET_SCHDATA(Proc)->num_tmp_heap_used -= (Size); \
- } while (0)
-# define UseTmpHeapNoproc(Size) \
- do { \
- erts_get_scheduler_data()->num_tmp_heap_used += (Size); \
- } while (0)
-# define UnUseTmpHeapNoproc(Size) \
- do { \
- erts_get_scheduler_data()->num_tmp_heap_used -= (Size); \
- } while (0)
-
-
-# endif
-
-#else
-# define DeclareTmpHeap(VariableName,Size,Process) \
+#define DeclareTmpHeap(VariableName,Size,Process) \
Eterm VariableName[Size]
-# define DeclareTypedTmpHeap(Type,VariableName,Process) \
+#define DeclareTypedTmpHeap(Type,VariableName,Process) \
Type VariableName[1]
-# define DeclareTmpHeapNoproc(VariableName,Size) \
+#define DeclareTmpHeapNoproc(VariableName,Size) \
Eterm VariableName[Size]
-# define UseTmpHeap(Size,Proc) /* Nothing */
-# define UnUseTmpHeap(Size,Proc) /* Nothing */
-# define UseTmpHeapNoproc(Size) /* Nothing */
-# define UnUseTmpHeapNoproc(Size) /* Nothing */
-#endif /* HEAP_ON_C_STACK */
+#define UseTmpHeap(Size,Proc) /* Nothing */
+#define UnUseTmpHeap(Size,Proc) /* Nothing */
+#define UseTmpHeapNoproc(Size) /* Nothing */
+#define UnUseTmpHeapNoproc(Size) /* Nothing */
ERTS_GLB_INLINE void dtrace_pid_str(Eterm pid, char *process_buf);
ERTS_GLB_INLINE void dtrace_proc_str(Process *process, char *process_buf);
@@ -1576,6 +1563,7 @@ dtrace_fun_decode(Process *process,
erts_snprintf(mfa_buf, DTRACE_TERM_BUF_SIZE, "%T:%T/%d",
module, function, arity);
}
+
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
#endif /* !__GLOBAL_H__ */
diff --git a/erts/emulator/beam/hash.c b/erts/emulator/beam/hash.c
index e0fde337f2..5a0b93f693 100644
--- a/erts/emulator/beam/hash.c
+++ b/erts/emulator/beam/hash.c
@@ -27,8 +27,6 @@
#endif
#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
#include "hash.h"
/*
@@ -66,6 +64,7 @@ void hash_get_info(HashInfo *hi, Hash *h)
int i;
int max_depth = 0;
int objects = 0;
+ int used = 0;
for (i = 0; i < size; i++) {
int depth = 0;
@@ -76,14 +75,18 @@ void hash_get_info(HashInfo *hi, Hash *h)
depth++;
b = b->next;
}
- if (depth > max_depth)
- max_depth = depth;
+ if (depth) {
+ used++;
+ if (depth > max_depth)
+ max_depth = depth;
+ }
}
+ ASSERT(objects == h->nobjs);
hi->name = h->name;
hi->size = h->size;
- hi->used = h->used;
- hi->objs = objects;
+ hi->used = used;
+ hi->objs = h->nobjs;
hi->depth = max_depth;
}
@@ -98,11 +101,11 @@ void hash_info(int to, void *arg, Hash* h)
hash_get_info(&hi, h);
- erts_print(to, arg, "=hash_table:%s\n", hi.name);
- erts_print(to, arg, "size: %d\n", hi.size);
- erts_print(to, arg, "used: %d\n", hi.used);
- erts_print(to, arg, "objs: %d\n", hi.objs);
- erts_print(to, arg, "depth: %d\n", hi.depth);
+ h->fun.meta_print(to, arg, "=hash_table:%s\n", hi.name);
+ h->fun.meta_print(to, arg, "size: %d\n", hi.size);
+ h->fun.meta_print(to, arg, "used: %d\n", hi.used);
+ h->fun.meta_print(to, arg, "objs: %d\n", hi.objs);
+ h->fun.meta_print(to, arg, "depth: %d\n", hi.depth);
}
@@ -119,47 +122,56 @@ hash_table_sz(Hash *h)
}
+static ERTS_INLINE void set_thresholds(Hash* h)
+{
+ h->grow_threshold = (8*h->size)/5; /* grow at 160% load */
+ if (h->size_ix > h->min_size_ix)
+ h->shrink_threshold = h->size / 5; /* shrink at 20% load */
+ else
+ h->shrink_threshold = -1; /* never shrink below inital size */
+}
+
/*
** init a pre allocated or static hash structure
** and allocate buckets.
*/
-Hash* hash_init(ErtsAlcType_t type, Hash* h, char* name, int size, HashFunctions fun)
+Hash* hash_init(int type, Hash* h, char* name, int size, HashFunctions fun)
{
int sz;
int ix = 0;
- h->type = type;
+ h->meta_alloc_type = type;
while (h_size_table[ix] != -1 && h_size_table[ix] < size)
ix++;
if (h_size_table[ix] == -1)
- erl_exit(1, "panic: too large hash table size (%d)\n", size);
+ return NULL;
size = h_size_table[ix];
sz = size*sizeof(HashBucket*);
- h->bucket = (HashBucket**) erts_alloc(h->type, sz);
+ h->bucket = (HashBucket**) fun.meta_alloc(h->meta_alloc_type, sz);
sys_memzero(h->bucket, sz);
h->is_allocated = 0;
h->name = name;
h->fun = fun;
h->size = size;
- h->size20percent = h->size/5;
- h->size80percent = (4*h->size)/5;
- h->ix = ix;
- h->used = 0;
+ h->size_ix = ix;
+ h->min_size_ix = ix;
+ h->nobjs = 0;
+ set_thresholds(h);
return h;
}
/*
** Create a new hash table
*/
-Hash* hash_new(ErtsAlcType_t type, char* name, int size, HashFunctions fun)
+Hash* hash_new(int type, char* name, int size, HashFunctions fun)
{
Hash* h;
- h = erts_alloc(type, sizeof(Hash));
+ h = fun.meta_alloc(type, sizeof(Hash));
h = hash_init(type, h, name, size, fun);
h->is_allocated = 1;
@@ -183,9 +195,9 @@ void hash_delete(Hash* h)
b = b_next;
}
}
- erts_free(h->type, h->bucket);
+ h->fun.meta_free(h->meta_alloc_type, h->bucket);
if (h->is_allocated)
- erts_free(h->type, (void*) h);
+ h->fun.meta_free(h->meta_alloc_type, (void*) h);
}
/*
@@ -199,39 +211,34 @@ static void rehash(Hash* h, int grow)
int i;
if (grow) {
- if ((h_size_table[h->ix+1]) == -1)
+ if ((h_size_table[h->size_ix+1]) == -1)
return;
- h->ix++;
+ h->size_ix++;
}
else {
- if (h->ix == 0)
+ if (h->size_ix == 0)
return;
- h->ix--;
+ h->size_ix--;
}
- h->size = h_size_table[h->ix];
- h->size20percent = h->size/5;
- h->size80percent = (4*h->size)/5;
+ h->size = h_size_table[h->size_ix];
sz = h->size*sizeof(HashBucket*);
- new_bucket = (HashBucket **) erts_alloc(h->type, sz);
+ new_bucket = (HashBucket **) h->fun.meta_alloc(h->meta_alloc_type, sz);
sys_memzero(new_bucket, sz);
- h->used = 0;
-
for (i = 0; i < old_size; i++) {
HashBucket* b = h->bucket[i];
while (b != (HashBucket*) 0) {
HashBucket* b_next = b->next;
int ix = b->hvalue % h->size;
- if (new_bucket[ix] == NULL)
- h->used++;
b->next = new_bucket[ix];
new_bucket[ix] = b;
b = b_next;
}
}
- erts_free(h->type, (void *) h->bucket);
+ h->fun.meta_free(h->meta_alloc_type, (void *) h->bucket);
h->bucket = new_bucket;
+ set_thresholds(h);
}
/*
@@ -268,68 +275,15 @@ void* hash_put(Hash* h, void* tmpl)
}
b = (HashBucket*) h->fun.alloc(tmpl);
- if (h->bucket[ix] == NULL)
- h->used++;
-
b->hvalue = hval;
b->next = h->bucket[ix];
h->bucket[ix] = b;
- if (h->used > h->size80percent) /* rehash at 80% */
+ if (++h->nobjs > h->grow_threshold)
rehash(h, 1);
return (void*) b;
}
-static void
-hash_insert_entry(Hash* h, HashBucket* entry)
-{
- HashValue hval = entry->hvalue;
- int ix = hval % h->size;
- HashBucket* b = h->bucket[ix];
-
- while (b != (HashBucket*) 0) {
- if ((b->hvalue == hval) && (h->fun.cmp((void*)entry, (void*)b) == 0)) {
- abort(); /* Should not happen */
- }
- b = b->next;
- }
-
- if (h->bucket[ix] == NULL)
- h->used++;
-
- entry->next = h->bucket[ix];
- h->bucket[ix] = entry;
-
- if (h->used > h->size80percent) /* rehash at 80% */
- rehash(h, 1);
-}
-
-
-/*
- * Move all entries in src into dst; empty src.
- * Entries in src must not exist in dst.
- */
-void
-erts_hash_merge(Hash* src, Hash* dst)
-{
- int limit = src->size;
- HashBucket** bucket = src->bucket;
- int i;
-
- src->used = 0;
- for (i = 0; i < limit; i++) {
- HashBucket* b = bucket[i];
- HashBucket* next;
-
- bucket[i] = NULL;
- while (b) {
- next = b->next;
- hash_insert_entry(dst, b);
- b = next;
- }
- }
-}
-
/*
** Erase hash entry return template if erased
** return 0 if not erased
@@ -348,9 +302,7 @@ void* hash_erase(Hash* h, void* tmpl)
else
h->bucket[ix] = b->next;
h->fun.free((void*)b);
- if (h->bucket[ix] == NULL)
- h->used--;
- if (h->used < h->size20percent) /* rehash at 20% */
+ if (--h->nobjs < h->shrink_threshold)
rehash(h, 0);
return tmpl;
}
@@ -381,9 +333,7 @@ hash_remove(Hash *h, void *tmpl)
prev->next = b->next;
else
h->bucket[ix] = b->next;
- if (h->bucket[ix] == NULL)
- h->used--;
- if (h->used < h->size20percent) /* rehash at 20% */
+ if (--h->nobjs < h->shrink_threshold)
rehash(h, 0);
return (void *) b;
}
diff --git a/erts/emulator/beam/hash.h b/erts/emulator/beam/hash.h
index 87fdb360e3..e94aaa0a84 100644
--- a/erts/emulator/beam/hash.h
+++ b/erts/emulator/beam/hash.h
@@ -29,14 +29,17 @@
#include "sys.h"
#endif
-#include "erl_alloc.h"
-
typedef unsigned long HashValue;
+typedef struct hash Hash;
typedef int (*HCMP_FUN)(void*, void*);
typedef HashValue (*H_FUN)(void*);
typedef void* (*HALLOC_FUN)(void*);
typedef void (*HFREE_FUN)(void*);
+/* Meta functions */
+typedef void* (*HMALLOC_FUN)(int,size_t);
+typedef void (*HMFREE_FUN)(int,void*);
+typedef int (*HMPRINT_FUN)(int,void*,char*, ...);
/*
** This bucket must be placed in top of
@@ -55,6 +58,9 @@ typedef struct hash_functions
HCMP_FUN cmp;
HALLOC_FUN alloc;
HFREE_FUN free;
+ HMALLOC_FUN meta_alloc;
+ HMFREE_FUN meta_free;
+ HMPRINT_FUN meta_print;
} HashFunctions;
typedef struct {
@@ -65,22 +71,23 @@ typedef struct {
int depth;
} HashInfo;
-typedef struct hash
+struct hash
{
HashFunctions fun; /* Function block */
int is_allocated; /* 0 iff hash structure is on stack or is static */
- ErtsAlcType_t type;
+ int meta_alloc_type; /* argument to pass to meta_alloc and meta_free */
char* name; /* Table name (static string, for debugging) */
int size; /* Number of slots */
- int size20percent; /* 20 percent of number of slots */
- int size80percent; /* 80 percent of number of slots */
- int ix; /* Size index in size table */
- int used; /* Number of slots used */
+ int shrink_threshold;
+ int grow_threshold;
+ int size_ix; /* Size index in size table */
+ int min_size_ix; /* Never shrink table smaller than this */
+ int nobjs; /* Number of objects in table */
HashBucket** bucket; /* Vector of bucket pointers (objects) */
-} Hash;
+};
-Hash* hash_new(ErtsAlcType_t, char*, int, HashFunctions);
-Hash* hash_init(ErtsAlcType_t, Hash*, char*, int, HashFunctions);
+Hash* hash_new(int, char*, int, HashFunctions);
+Hash* hash_init(int, Hash*, char*, int, HashFunctions);
void hash_delete(Hash*);
void hash_get_info(HashInfo*, Hash*);
@@ -93,6 +100,4 @@ void* hash_erase(Hash*, void*);
void* hash_remove(Hash*, void*);
void hash_foreach(Hash*, void (*func)(void *, void *), void *);
-void erts_hash_merge(Hash* src, Hash* dst);
-
#endif
diff --git a/erts/emulator/beam/index.h b/erts/emulator/beam/index.h
index 14fab41026..99b2bdfab0 100644
--- a/erts/emulator/beam/index.h
+++ b/erts/emulator/beam/index.h
@@ -30,6 +30,10 @@
#include "hash.h"
#endif
+#ifndef ERL_ALLOC_H__
+#include "erl_alloc.h"
+#endif
+
typedef struct index_slot
{
HashBucket bucket;
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 2bd31ee97e..41b0fcdd1b 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -53,10 +53,11 @@
#include "erl_time.h"
extern ErlDrvEntry fd_driver_entry;
-#ifndef __OSE__
extern ErlDrvEntry vanilla_driver_entry;
-#endif
extern ErlDrvEntry spawn_driver_entry;
+#ifndef __WIN32__
+extern ErlDrvEntry forker_driver_entry;
+#endif
extern ErlDrvEntry *driver_tab[]; /* table of static drivers, only used during initialization */
erts_driver_t *driver_list; /* List of all drivers, static and dynamic. */
@@ -74,6 +75,9 @@ const Port erts_invalid_port = {{ERTS_INVALID_PORT}};
erts_driver_t vanilla_driver;
erts_driver_t spawn_driver;
+#ifndef __WIN32__
+erts_driver_t forker_driver;
+#endif
erts_driver_t fd_driver;
int erts_port_synchronous_ops = 0;
@@ -87,6 +91,7 @@ static void deliver_result(Eterm sender, Eterm pid, Eterm res);
static int init_driver(erts_driver_t *, ErlDrvEntry *, DE_Handle *);
static void terminate_port(Port *p);
static void pdl_init(void);
+static int driver_failure_term(ErlDrvPort ix, Eterm term, int eof);
#ifdef ERTS_SMP
static void driver_monitor_lock_pdl(Port *p);
static void driver_monitor_unlock_pdl(Port *p);
@@ -308,12 +313,9 @@ static Port *create_port(char *name,
size_t port_size, busy_port_queue_size, size;
erts_aint32_t state = ERTS_PORT_SFLG_CONNECTED;
erts_aint32_t x_pts_flgs = 0;
-#ifdef DEBUG
- /* Make sure the debug flags survives until port is freed */
- state |= ERTS_PORT_SFLG_PORT_DEBUG;
-#endif
#ifdef ERTS_SMP
+ ErtsRunQueue *runq;
if (!driver_lock) {
/* Align size for mutex following port struct */
port_size = size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port));
@@ -323,6 +325,12 @@ static Port *create_port(char *name,
#endif
port_size = size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port));
+#ifdef DEBUG
+ /* Make sure the debug flags survives until port is freed */
+ state |= ERTS_PORT_SFLG_PORT_DEBUG;
+#endif
+
+
busy_port_queue_size
= ((driver->flags & ERL_DRV_FLAG_NO_BUSY_MSGQ)
? 0
@@ -358,8 +366,12 @@ static Port *create_port(char *name,
p += sizeof(erts_mtx_t);
state |= ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK;
}
- erts_smp_atomic_set_nob(&prt->run_queue,
- (erts_aint_t) erts_get_runq_current(NULL));
+ if (erts_get_scheduler_data())
+ runq = erts_get_runq_current(NULL);
+ else
+ runq = ERTS_RUNQ_IX(0);
+ erts_smp_atomic_set_nob(&prt->run_queue, (erts_aint_t) runq);
+
prt->xports = NULL;
#else
erts_atomic32_init_nob(&prt->refc, 1);
@@ -386,6 +398,7 @@ static Port *create_port(char *name,
ERTS_PTMR_INIT(prt);
erts_port_task_handle_init(&prt->timeout_task);
prt->psd = NULL;
+ prt->async_open_port = NULL;
prt->drv_data = (SWord) 0;
prt->os_pid = -1;
@@ -467,6 +480,11 @@ erts_port_free(Port *prt)
erts_port_task_fini_sched(&prt->sched);
+ if (prt->async_open_port) {
+ erts_free(ERTS_ALC_T_PRTSD, prt->async_open_port);
+ prt->async_open_port = NULL;
+ }
+
#ifdef ERTS_SMP
ASSERT(prt->lock);
if (state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK)
@@ -688,6 +706,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
error_number = error_type = 0;
if (driver->start) {
+ ERTS_MSACC_PUSH_STATE_M();
if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(port, am_in, am_start);
}
@@ -698,6 +717,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
DTRACE3(driver_start, process_str, driver->name, port_str);
}
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
fpe_was_unmasked = erts_block_fpe();
drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts);
if (((SWord) drv_data) == -1)
@@ -717,6 +737,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
}
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
port->caller = NIL;
if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(port, am_out, am_start);
@@ -1106,7 +1127,7 @@ io_list_vec_len(Eterm obj, int* vsize, Uint* csize,
Uint p_v_size = 0;
Uint p_c_size = 0;
Uint p_in_clist = 0;
- Uint total; /* Uint due to halfword emulator */
+ Uint total;
goto L_jump_start; /* avoid a push */
@@ -1413,7 +1434,7 @@ queue_port_sched_op_reply(Process *rp,
erts_factory_trim_and_close(factory, &msg, 1);
- erts_queue_message(rp, rp_locksp, factory->heap_frags, msg, NIL);
+ erts_queue_message(rp, rp_locksp, factory->message, msg, NIL);
}
static void
@@ -1421,12 +1442,9 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg)
{
Process *rp = erts_proc_lookup_raw(to);
if (rp) {
- ErlOffHeap *ohp;
- ErlHeapFragment* bp;
ErtsHeapFactory factory;
Eterm msg_copy;
Uint hsz, msg_sz;
- Eterm *hp;
ErtsProcLocks rp_locks = 0;
hsz = ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
@@ -1437,18 +1455,13 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg)
hsz += msg_sz;
}
- hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- rp,
- &rp_locks);
- erts_factory_message_init(&factory, rp, hp, bp);
- if (is_immed(msg))
- msg_copy = msg;
- else {
- msg_copy = copy_struct(msg, msg_sz, &hp, ohp);
- factory.hp = hp;
- }
+ (void) erts_factory_message_create(&factory, rp,
+ &rp_locks, hsz);
+ msg_copy = (is_immed(msg)
+ ? msg
+ : copy_struct(msg, msg_sz,
+ &factory.hp,
+ factory.off_heap));
queue_port_sched_op_reply(rp,
&rp_locks,
@@ -1536,6 +1549,26 @@ erts_schedule_proc2port_signal(Process *c_p,
return ERTS_PORT_OP_SCHEDULED;
}
+static int
+erts_schedule_port2port_signal(Eterm port_num, ErtsProc2PortSigData *sigdp,
+ int task_flags,
+ ErtsProc2PortSigCallback callback)
+{
+ Port *prt = erts_port_lookup_raw(port_num);
+
+ if (!prt)
+ return -1;
+
+ sigdp->caller = ERTS_INVALID_PID;
+
+ return erts_port_task_schedule(prt->common.id,
+ NULL,
+ ERTS_PORT_TASK_PROC_SIG,
+ sigdp,
+ callback,
+ task_flags);
+}
+
static ERTS_INLINE void
send_badsig(Port *prt) {
ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND;
@@ -1680,6 +1713,7 @@ call_driver_outputv(int bang_op,
else {
ErtsSchedulerData *esdp = erts_get_scheduler_data();
ErlDrvSizeT size = evp->size;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT);
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)
|| ERTS_IS_CRASH_DUMPING);
@@ -1700,6 +1734,8 @@ call_driver_outputv(int bang_op,
esdp->io.out += (Uint64) size;
else
erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size);
+
+ ERTS_MSACC_POP_STATE_M();
}
}
@@ -1780,6 +1816,7 @@ call_driver_output(int bang_op,
send_badsig(prt);
else {
ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT);
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)
|| ERTS_IS_CRASH_DUMPING);
@@ -1799,6 +1836,8 @@ call_driver_output(int bang_op,
esdp->io.out += (Uint64) size;
else
erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size);
+
+ ERTS_MSACC_POP_STATE_M();
}
}
@@ -2371,6 +2410,11 @@ erts_port_exit(Process *c_p,
| ERTS_PORT_SIG_FLG_BROKEN_LINK
| ERTS_PORT_SIG_FLG_FORCE_SCHED)) == 0);
+#ifndef __WIN32__
+ if (prt->drv_ptr == &forker_driver)
+ return ERTS_PORT_OP_DROPPED;
+#endif
+
if (!(flags & ERTS_PORT_SIG_FLG_FORCE_SCHED)) {
ErtsTryImmDrvCallState try_call_state
= ERTS_INIT_TRY_IMM_DRV_CALL_STATE(c_p,
@@ -2735,6 +2779,72 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp)
port_sig_link);
}
+static void
+init_ack_send_reply(Port *port, Eterm resp)
+{
+
+ if (!is_internal_port(resp)) {
+ Process *rp = erts_proc_lookup_raw(port->async_open_port->to);
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
+ erts_remove_link(&ERTS_P_LINKS(port), port->async_open_port->to);
+ erts_remove_link(&ERTS_P_LINKS(rp), port->common.id);
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ }
+ port_sched_op_reply(port->async_open_port->to,
+ port->async_open_port->ref,
+ resp);
+
+ erts_free(ERTS_ALC_T_PRTSD, port->async_open_port);
+ port->async_open_port = NULL;
+}
+
+void
+erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res) {
+ Port *port = erts_drvport2port(ix);
+ SWord err_type = (SWord)res;
+ Eterm resp;
+
+ if (port == ERTS_INVALID_ERL_DRV_PORT && port->async_open_port)
+ return;
+
+ if (port->async_open_port) {
+ switch(err_type) {
+ case -3:
+ resp = am_badarg;
+ break;
+ case -2: {
+ char *str = erl_errno_id(errno);
+ resp = erts_atom_put((byte *) str, strlen(str),
+ ERTS_ATOM_ENC_LATIN1, 1);
+ break;
+ }
+ case -1:
+ resp = am_einval;
+ break;
+ default:
+ resp = port->common.id;
+ break;
+ }
+
+ init_ack_send_reply(port, resp);
+
+ if (err_type == -1 || err_type == -2 || err_type == -3)
+ driver_failure_term(ix, am_normal, 0);
+ port->drv_data = err_type;
+ }
+}
+
+void
+erl_drv_set_os_pid(ErlDrvPort ix, ErlDrvSInt pid) {
+ Port *port = erts_drvport2port(ix);
+
+ if (port == ERTS_INVALID_ERL_DRV_PORT)
+ return;
+
+ port->os_pid = (SWord)pid;
+
+}
+
void erts_init_io(int port_tab_size,
int port_tab_size_ignore_files,
int legacy_port_tab)
@@ -2795,10 +2905,11 @@ void erts_init_io(int port_tab_size,
erts_smp_rwmtx_rwlock(&erts_driver_list_lock);
init_driver(&fd_driver, &fd_driver_entry, NULL);
-#ifndef __OSE__
init_driver(&vanilla_driver, &vanilla_driver_entry, NULL);
-#endif
init_driver(&spawn_driver, &spawn_driver_entry, NULL);
+#ifndef __WIN32__
+ init_driver(&forker_driver, &forker_driver_entry, NULL);
+#endif
erts_init_static_drivers();
for (dp = driver_tab; *dp != NULL; dp++)
erts_add_driver_entry(*dp, NULL, 1);
@@ -2860,6 +2971,9 @@ void erts_lcnt_enable_io_lock_count(int enable) {
lcnt_enable_drv_lock_count(&vanilla_driver, enable);
lcnt_enable_drv_lock_count(&spawn_driver, enable);
+#ifndef __WIN32__
+ lcnt_enable_drv_lock_count(&forker_driver, enable);
+#endif
lcnt_enable_drv_lock_count(&fd_driver, enable);
/* enable lock counting in all drivers */
for (dp = driver_list; dp; dp = dp->next) {
@@ -3055,16 +3169,17 @@ deliver_result(Eterm sender, Eterm pid, Eterm res)
if (rp) {
Eterm tuple;
- ErlHeapFragment *bp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
Eterm* hp;
Uint sz_res;
sz_res = size_object(res);
- hp = erts_alloc_message_heap(sz_res + 3, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks,
+ sz_res + 3, &hp, &ohp);
res = copy_struct(res, sz_res, &hp, ohp);
tuple = TUPLE2(hp, sender, res);
- erts_queue_message(rp, &rp_locks, bp, tuple, NIL);
+ erts_queue_message(rp, &rp_locks, mp, tuple, NIL);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
@@ -3092,7 +3207,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
Eterm tuple;
Process* rp;
Eterm* hp;
- ErlHeapFragment *bp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
ErtsProcLocks rp_locks = 0;
int scheduler = erts_get_scheduler_id() != 0;
@@ -3118,7 +3233,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
if (!rp)
return;
- hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, need, &hp, &ohp);
listp = NIL;
if ((state & ERTS_PORT_SFLG_BINARY_IO) == 0) {
@@ -3160,7 +3275,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
tuple = TUPLE2(hp, prt->common.id, tuple);
hp += 3;
- erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined);
+ erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
@@ -3234,7 +3349,7 @@ deliver_vec_message(Port* prt, /* Port */
Eterm tuple;
Process* rp;
Eterm* hp;
- ErlHeapFragment *bp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
ErtsProcLocks rp_locks = 0;
int scheduler = erts_get_scheduler_id() != 0;
@@ -3266,7 +3381,7 @@ deliver_vec_message(Port* prt, /* Port */
need += (hlen+csize)*2;
}
- hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, need, &hp, &ohp);
listp = NIL;
iov += vsize;
@@ -3327,7 +3442,7 @@ deliver_vec_message(Port* prt, /* Port */
tuple = TUPLE2(hp, prt->common.id, tuple);
hp += 3;
- erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined);
+ erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined);
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
erts_proc_dec_refc(rp);
@@ -3367,6 +3482,7 @@ static void flush_port(Port *p)
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
if (p->drv_ptr->flush != NULL) {
+ ERTS_MSACC_PUSH_STATE_M();
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(driver_flush)) {
DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p)
@@ -3376,9 +3492,11 @@ static void flush_port(Port *p)
if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(p, am_in, am_flush);
}
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
fpe_was_unmasked = erts_block_fpe();
(*p->drv_ptr->flush)((ErlDrvData)p->drv_data);
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(p, am_out, am_flush);
}
@@ -3426,6 +3544,7 @@ terminate_port(Port *prt)
drv = prt->drv_ptr;
if ((drv != NULL) && (drv->stop != NULL)) {
int fpe_was_unmasked = erts_block_fpe();
+ ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT);
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(driver_stop)) {
DTRACE_FORMAT_COMMON_PID_AND_PORT(connected_id, prt)
@@ -3434,6 +3553,7 @@ terminate_port(Port *prt)
#endif
(*drv->stop)((ErlDrvData)prt->drv_data);
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
#ifdef ERTS_SMP
if (prt->xports)
erts_port_handle_xports(prt);
@@ -3744,6 +3864,7 @@ call_driver_control(Eterm caller,
ErlDrvSizeT *from_size)
{
ErlDrvSSizeT cres;
+ ERTS_MSACC_PUSH_STATE_M();
if (!prt->drv_ptr->control)
return ERTS_PORT_OP_BADARG;
@@ -3757,6 +3878,8 @@ call_driver_control(Eterm caller,
command, size);
}
#endif
+
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
prt->caller = caller;
cres = prt->drv_ptr->control((ErlDrvData) prt->drv_data,
@@ -3767,6 +3890,8 @@ call_driver_control(Eterm caller,
*from_size);
prt->caller = NIL;
+ ERTS_MSACC_POP_STATE_M();
+
if (cres < 0)
return ERTS_PORT_OP_BADARG;
@@ -3818,7 +3943,6 @@ write_port_control_result(int control_flags,
ErlDrvSizeT resp_size,
char *pre_alloc_buf,
Eterm **hpp,
- ErlHeapFragment *bp,
ErlOffHeap *ohp)
{
Eterm res;
@@ -3892,16 +4016,13 @@ port_sig_control(Port *prt,
if (res == ERTS_PORT_OP_DONE) {
Eterm msg;
- Eterm *hp;
- ErlHeapFragment *bp;
- ErlOffHeap *ohp;
ErtsHeapFactory factory;
Process *rp;
ErtsProcLocks rp_locks = 0;
Uint hsz, rsz;
int control_flags;
- rp = erts_proc_lookup_raw(sigdp->caller);
+ rp = sigdp->caller == ERTS_INVALID_PID ? NULL : erts_proc_lookup_raw(sigdp->caller);
if (!rp)
goto done;
@@ -3914,22 +4035,15 @@ port_sig_control(Port *prt,
hsz = rsz + ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
- hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- rp,
- &rp_locks);
- erts_factory_message_init(&factory, rp, hp, bp);
+ (void) erts_factory_message_create(&factory, rp,
+ &rp_locks, hsz);
msg = write_port_control_result(control_flags,
resp_bufp,
resp_size,
&resp_buf[0],
- &hp,
- bp,
- ohp);
- factory.hp = hp;
-
+ &factory.hp,
+ factory.off_heap);
queue_port_sched_op_reply(rp,
&rp_locks,
&factory,
@@ -3944,7 +4058,8 @@ port_sig_control(Port *prt,
/* failure */
- port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg);
+ if (sigdp->caller != ERTS_INVALID_PID)
+ port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg);
done:
@@ -3954,6 +4069,23 @@ done:
return ERTS_PORT_REDS_CONTROL;
}
+/*
+ * This is an asynchronous control call. I.e. it will not return anything
+ * to the caller.
+ */
+int
+erl_drv_port_control(Eterm port_num, char cmd, char* buff, ErlDrvSizeT size)
+{
+ ErtsProc2PortSigData *sigdp = erts_port_task_alloc_p2p_sig_data();
+
+ sigdp->flags = ERTS_P2P_SIG_TYPE_CONTROL | ERTS_P2P_SIG_DATA_FLG_REPLY;
+ sigdp->u.control.binp = NULL;
+ sigdp->u.control.command = cmd;
+ sigdp->u.control.bufp = buff;
+ sigdp->u.control.size = size;
+
+ return erts_schedule_port2port_signal(port_num, sigdp, 0, port_sig_control);
+}
ErtsPortOpResult
erts_port_control(Process* c_p,
@@ -4070,7 +4202,6 @@ erts_port_control(Process* c_p,
resp_size,
&resp_buf[0],
&hp,
- NULL,
&c_p->off_heap);
BUMP_REDS(c_p, ERTS_PORT_REDS_CONTROL);
return ERTS_PORT_OP_DONE;
@@ -4092,10 +4223,10 @@ erts_port_control(Process* c_p,
binp = NULL;
if (is_binary(data) && binary_bitoffset(data) == 0) {
- Eterm *ebinp = binary_val_rel(data, NULL);
+ Eterm *ebinp = binary_val(data);
ASSERT(!tmp_alloced);
if (*ebinp == HEADER_SUB_BIN)
- ebinp = binary_val_rel(((ErlSubBin *) ebinp)->orig, NULL);
+ ebinp = binary_val(((ErlSubBin *) ebinp)->orig);
if (*ebinp != HEADER_PROC_BIN)
copy = 1;
else {
@@ -4148,6 +4279,7 @@ call_driver_call(Eterm caller,
unsigned *ret_flagsp)
{
ErlDrvSSizeT cres;
+ ERTS_MSACC_PUSH_STATE_M();
if (!prt->drv_ptr->call)
return ERTS_PORT_OP_BADARG;
@@ -4163,6 +4295,8 @@ call_driver_call(Eterm caller,
}
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
+
prt->caller = caller;
cres = prt->drv_ptr->call((ErlDrvData) prt->drv_data,
command,
@@ -4173,6 +4307,8 @@ call_driver_call(Eterm caller,
ret_flagsp);
prt->caller = NIL;
+ ERTS_MSACC_POP_STATE_M();
+
if (cres <= 0
|| ((byte) (*resp_bufp)[0]) != VERSION_MAGIC)
return ERTS_PORT_OP_BADARG;
@@ -4229,21 +4365,14 @@ port_sig_call(Port *prt,
hsz = erts_decode_ext_size((byte *) resp_bufp, resp_size);
if (hsz >= 0) {
- ErlHeapFragment* bp;
- ErlOffHeap* ohp;
ErtsHeapFactory factory;
byte *endp;
hsz += 3; /* ok tuple */
hsz += ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
- hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- rp,
- &rp_locks);
+ (void) erts_factory_message_create(&factory, rp, &rp_locks, hsz);
endp = (byte *) resp_bufp;
- erts_factory_message_init(&factory, rp, hp, bp);
msg = erts_decode_ext(&factory, &endp);
if (is_value(msg)) {
hp = erts_produce_heap(&factory,
@@ -4504,7 +4633,9 @@ port_sig_info(Port *prt,
sigdp->u.info.item);
if (is_value(value)) {
ErtsHeapFactory factory;
- erts_factory_message_init(&factory, NULL, hp, bp);
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_factory_selfcontained_message_init(&factory, mp, hp);
queue_port_sched_op_reply(rp,
&rp_locks,
&factory,
@@ -4592,8 +4723,8 @@ reply_io_bytes(void *vreq)
rp = erts_proc_lookup(req->pid);
if (rp) {
- ErlOffHeap *ohp = NULL;
- ErlHeapFragment *bp = NULL;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
ErtsProcLocks rp_locks;
Eterm ref, msg, ein, eout, *hp;
Uint64 in, out;
@@ -4615,7 +4746,7 @@ reply_io_bytes(void *vreq)
erts_bld_uint64(NULL, &hsz, in);
erts_bld_uint64(NULL, &hsz, out);
- hp = erts_alloc_message_heap(hsz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp);
ref = make_internal_ref(hp);
write_ref_thing(hp, req->refn[0], req->refn[1], req->refn[2]);
@@ -4625,7 +4756,7 @@ reply_io_bytes(void *vreq)
eout = erts_bld_uint64(&hp, NULL, out);
msg = TUPLE4(hp, ref, make_small(sched_id), ein, eout);
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (req->sched_id == sched_id)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -4731,6 +4862,10 @@ print_port_info(Port *p, int to, void *arg)
erts_print(to, arg, "Port is a file: %s\n",p->name);
} else if (p->drv_ptr == &spawn_driver) {
erts_print(to, arg, "Port controls external process: %s\n",p->name);
+#ifndef __WIN32__
+ } else if (p->drv_ptr == &forker_driver) {
+ erts_print(to, arg, "Port controls forker process: %s\n",p->name);
+#endif
} else {
erts_print(to, arg, "Port controls linked-in driver: %s\n",p->name);
}
@@ -4877,6 +5012,7 @@ 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));
@@ -4897,9 +5033,11 @@ void erts_raw_port_command(Port* p, byte* buf, Uint len)
DTRACE4(driver_output, "-raw-", port_str, p->name, len);
}
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
fpe_was_unmasked = erts_block_fpe();
(*p->drv_ptr->output)((ErlDrvData)p->drv_data, (char*) buf, (int) len);
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
}
int async_ready(Port *p, void* data)
@@ -4911,6 +5049,7 @@ int async_ready(Port *p, void* data)
if (p) {
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
if (p->drv_ptr->ready_async != NULL) {
+ ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT);
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(driver_ready_async)) {
DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p)
@@ -4919,6 +5058,7 @@ int async_ready(Port *p, void* data)
#endif
(*p->drv_ptr->ready_async)((ErlDrvData)p->drv_data, data);
need_free = 0;
+ ERTS_MSACC_POP_STATE_M();
}
erts_port_driver_callback_epilogue(p, NULL);
@@ -5070,11 +5210,11 @@ ErlDrvTermData driver_mk_term_nil(void)
void driver_report_exit(ErlDrvPort ix, int status)
{
Eterm* hp;
+ ErlOffHeap *ohp;
Eterm tuple;
Process *rp;
Eterm pid;
- ErlHeapFragment *bp = NULL;
- ErlOffHeap *ohp;
+ ErtsMessage *mp;
ErtsProcLocks rp_locks = 0;
int scheduler = erts_get_scheduler_id() != 0;
Port* prt = erts_drvport2port(ix);
@@ -5094,13 +5234,13 @@ void driver_report_exit(ErlDrvPort ix, int status)
if (!rp)
return;
- hp = erts_alloc_message_heap(3+3, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, 3+3, &hp, &ohp);
tuple = TUPLE2(hp, am_exit_status, make_small(status));
hp += 3;
tuple = TUPLE2(hp, prt->common.id, tuple);
- erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined);
+ erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined);
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
@@ -5210,7 +5350,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
ErtsProcLocks rp_locks = 0;
struct b2t_states__ b2t;
int scheduler;
- int is_heap_need_limited = 1;
ErtsSchedulerData *esdp = erts_get_scheduler_data();
ERTS_UNDEF(mess,NIL);
@@ -5249,25 +5388,17 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
break;
case ERL_DRV_INT: /* signed int argument */
ERTS_DDT_CHK_ENOUGH_ARGS(1);
-#if HALFWORD_HEAP
- erts_bld_sint64(NULL, &need, (Sint64)ptr[0]);
-#else
/* check for bignum */
if (!IS_SSMALL((Sint)ptr[0]))
need += BIG_UINT_HEAP_SIZE; /* use small_to_big */
-#endif
ptr++;
depth++;
break;
case ERL_DRV_UINT: /* unsigned int argument */
ERTS_DDT_CHK_ENOUGH_ARGS(1);
-#if HALFWORD_HEAP
- erts_bld_uint64(NULL, &need, (Uint64)ptr[0]);
-#else
/* check for bignum */
if (!IS_USMALL(0, (Uint)ptr[0]))
need += BIG_UINT_HEAP_SIZE; /* use small_to_big */
-#endif
ptr++;
depth++;
break;
@@ -5387,9 +5518,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
need += hsz;
ptr += 2;
depth++;
- if (size > MAP_SMALL_MAP_LIMIT*3) { /* may contain big map */
- is_heap_need_limited = 0;
- }
break;
}
case ERL_DRV_MAP: { /* int */
@@ -5397,7 +5525,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
if ((int) ptr[0] < 0) ERTS_DDT_FAIL;
if (ptr[0] > MAP_SMALL_MAP_LIMIT) {
need += HASHMAP_ESTIMATED_HEAP_SIZE(ptr[0]);
- is_heap_need_limited = 0;
} else {
need += MAP_HEADER_FLATMAP_SZ + 1 + 2*ptr[0];
}
@@ -5436,17 +5563,7 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
goto done;
}
- /* Try copy directly to destination heap if we know there are no big maps */
- if (is_heap_need_limited) {
- ErlOffHeap *ohp;
- ErlHeapFragment* bp;
- Eterm* hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks);
- erts_factory_message_init(&factory, rp, hp, bp);
- }
- else {
- erts_factory_message_init(&factory, NULL, NULL,
- new_message_buffer(need));
- }
+ (void) erts_factory_message_create(&factory, rp, &rp_locks, need);
/*
* Interpret the instructions and build the term.
@@ -5466,10 +5583,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
break;
case ERL_DRV_INT: /* signed int argument */
-#if HALFWORD_HEAP
- erts_reserve_heap(&factory, BIG_NEED_SIZE(2));
- mess = erts_bld_sint64(&factory.hp, NULL, (Sint64)ptr[0]);
-#else
erts_reserve_heap(&factory, BIG_UINT_HEAP_SIZE);
if (IS_SSMALL((Sint)ptr[0]))
mess = make_small((Sint)ptr[0]);
@@ -5477,15 +5590,10 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
mess = small_to_big((Sint)ptr[0], factory.hp);
factory.hp += BIG_UINT_HEAP_SIZE;
}
-#endif
ptr++;
break;
case ERL_DRV_UINT: /* unsigned int argument */
-#if HALFWORD_HEAP
- erts_reserve_heap(&factory, BIG_NEED_FOR_BITS(64));
- mess = erts_bld_uint64(&factory.hp, NULL, (Uint64)ptr[0]);
-#else
erts_reserve_heap(&factory, BIG_UINT_HEAP_SIZE);
if (IS_USMALL(0, (Uint)ptr[0]))
mess = make_small((Uint)ptr[0]);
@@ -5493,7 +5601,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
mess = uint_to_big((Uint)ptr[0], factory.hp);
factory.hp += BIG_UINT_HEAP_SIZE;
}
-#endif
ptr++;
break;
@@ -5725,9 +5832,9 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
if (res > 0) {
mess = ESTACK_POP(stack); /* get resulting value */
- erts_factory_close(&factory);
+ erts_factory_trim_and_close(&factory, &mess, 1);
/* send message */
- erts_queue_message(rp, &rp_locks, factory.heap_frags, mess, am_undefined);
+ erts_queue_message(rp, &rp_locks, factory.message, mess, am_undefined);
}
else {
if (b2t.ix > b2t.used)
@@ -6832,7 +6939,7 @@ int driver_monitor_process(ErlDrvPort drvport,
{
Port *prt;
int ret;
-#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK))
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsSchedulerData *sched = erts_get_scheduler_data();
#endif
@@ -6843,16 +6950,6 @@ int driver_monitor_process(ErlDrvPort drvport,
/* Now (in SMP) we should have either the port lock (if we have a scheduler) or the port data lock
(if we're a driver thread) */
ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock));
-
-#if !HEAP_ON_C_STACK
- if (!sched) {
- /* Need a separate allocation for the ref :( */
- Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM,
- sizeof(Eterm)*REF_THING_SIZE);
- ret = do_driver_monitor_process(prt,buf,process,monitor);
- erts_free(ERTS_ALC_T_TEMP_TERM,buf);
- } else
-#endif
{
DeclareTmpHeapNoproc(buf,REF_THING_SIZE);
UseTmpHeapNoproc(REF_THING_SIZE);
@@ -6905,7 +7002,7 @@ int driver_demonitor_process(ErlDrvPort drvport,
{
Port *prt;
int ret;
-#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK))
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsSchedulerData *sched = erts_get_scheduler_data();
#endif
@@ -6916,15 +7013,6 @@ int driver_demonitor_process(ErlDrvPort drvport,
/* Now we should have either the port lock (if we have a scheduler) or the port data lock
(if we're a driver thread) */
ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock));
-#if !HEAP_ON_C_STACK
- if (!sched) {
- /* Need a separate allocation for the ref :( */
- Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM,
- sizeof(Eterm)*REF_THING_SIZE);
- ret = do_driver_demonitor_process(prt,buf,monitor);
- erts_free(ERTS_ALC_T_TEMP_TERM,buf);
- } else
-#endif
{
DeclareTmpHeapNoproc(buf,REF_THING_SIZE);
UseTmpHeapNoproc(REF_THING_SIZE);
@@ -6960,7 +7048,7 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport,
{
Port *prt;
ErlDrvTermData ret;
-#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK))
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsSchedulerData *sched = erts_get_scheduler_data();
#endif
@@ -6971,16 +7059,6 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport,
/* Now we should have either the port lock (if we have a scheduler) or the port data lock
(if we're a driver thread) */
ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock));
-
-#if !HEAP_ON_C_STACK
- if (!sched) {
- /* Need a separate allocation for the ref :( */
- Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM,
- sizeof(Eterm)*REF_THING_SIZE);
- ret = do_driver_get_monitored_process(prt,buf,monitor);
- erts_free(ERTS_ALC_T_TEMP_TERM,buf);
- } else
-#endif
{
DeclareTmpHeapNoproc(buf,REF_THING_SIZE);
UseTmpHeapNoproc(REF_THING_SIZE);
@@ -7004,6 +7082,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref)
void (*callback)(ErlDrvData drv_data, ErlDrvMonitor *monitor);
ErlDrvMonitor drv_monitor;
int fpe_was_unmasked;
+ ERTS_MSACC_PUSH_STATE_M();
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
ASSERT(prt->drv_ptr != NULL);
@@ -7015,6 +7094,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref)
callback = prt->drv_ptr->process_exit;
ASSERT(callback != NULL);
ref_to_driver_monitor(ref,&drv_monitor);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
DRV_MONITOR_UNLOCK_PDL(prt);
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(driver_process_exit)) {
@@ -7026,6 +7106,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref)
(*callback)((ErlDrvData) (prt->drv_data), &drv_monitor);
erts_unblock_fpe(fpe_was_unmasked);
DRV_MONITOR_LOCK_PDL(prt);
+ ERTS_MSACC_POP_STATE_M();
/* remove monitor *after* callback */
rmon = erts_remove_monitor(&ERTS_P_MONITORS(prt), ref);
DRV_MONITOR_UNLOCK_PDL(prt);
@@ -7046,6 +7127,9 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof)
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+
+ if (prt->async_open_port)
+ init_ack_send_reply(prt, prt->common.id);
if (eof)
flush_linebuf_messages(prt, state);
if (state & ERTS_PORT_SFLG_CLOSING) {
diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c
index 86dd3b5aac..f5c7b177d3 100644
--- a/erts/emulator/beam/module.c
+++ b/erts/emulator/beam/module.c
@@ -74,8 +74,8 @@ static Module* module_alloc(Module* tmpl)
erts_smp_atomic_add_nob(&tot_module_bytes, sizeof(Module));
obj->module = tmpl->module;
- obj->curr.code = 0;
- obj->old.code = 0;
+ obj->curr.code_hdr = 0;
+ obj->old.code_hdr = 0;
obj->curr.code_length = 0;
obj->old.code_length = 0;
obj->slot.index = -1;
@@ -103,6 +103,9 @@ void init_module_table(void)
f.cmp = (HCMP_FUN) module_cmp;
f.alloc = (HALLOC_FUN) module_alloc;
f.free = (HFREE_FUN) module_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
for (i = 0; i < ERTS_NUM_CODE_IX; i++) {
erts_index_init(ERTS_ALC_T_MODULE_TABLE, &module_tables[i], "module_code",
diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h
index c8a6351b04..e66d628ca9 100644
--- a/erts/emulator/beam/module.h
+++ b/erts/emulator/beam/module.h
@@ -26,7 +26,7 @@
#endif
struct erl_module_instance {
- BeamInstr* code;
+ BeamCodeHeader* code_hdr;
int code_length; /* Length of loaded code in bytes. */
unsigned catches;
struct erl_module_nif* nif;
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 1d32e72247..9e53b4bfcc 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -39,8 +39,8 @@ too_old_compiler | never() =>
# necessary.) Since the instructions don't work correctly in R12B, simply
# refuse to load the module.
-func_info M=a a==am_module_info A=u==0 | label L | move n r => too_old_compiler
-func_info M=a a==am_module_info A=u==1 | label L | move n r => too_old_compiler
+func_info M=a a==am_module_info A=u==0 | label L | move n x==0 => too_old_compiler
+func_info M=a a==am_module_info A=u==1 | label L | move n x==0 => too_old_compiler
# The undocumented and unsupported guard BIF is_constant/1 was removed
# in R13. The is_constant/2 operation is marked as obsolete in genop.tab,
@@ -76,17 +76,6 @@ return
# with the following call instruction, we need to make sure that
# there is no line/1 instruction between the move and the call.
#
-
-move S r | line Loc | call_ext Ar Func => \
- line Loc | move S r | call_ext Ar Func
-move S r | line Loc | call_ext_last Ar Func=u$is_bif D => \
- line Loc | move S r | call_ext_last Ar Func D
-move S r | line Loc | call_ext_only Ar Func=u$is_bif => \
- line Loc | move S r | call_ext_only Ar Func
-move S r | line Loc | call Ar Func => \
- line Loc | move S r | call Ar Func
-
-#
# A tail-recursive call to an external function (non-BIF) will
# never be saved on the stack, so there is no reason to keep
# the line instruction. (The compiler did not remove the line
@@ -94,10 +83,14 @@ move S r | line Loc | call Ar Func => \
# BIFs and ordinary Erlang functions.)
#
-line Loc | call_ext_last Ar Func=u$is_not_bif D => \
- call_ext_last Ar Func D
-line Loc | call_ext_only Ar Func=u$is_not_bif => \
- call_ext_only Ar Func
+move S X0=x==0 | line Loc | call_ext Ar Func => \
+ line Loc | move S X0 | call_ext Ar Func
+move S X0=x==0 | line Loc | call_ext_last Ar Func=u$is_not_bif D => \
+ move S X0 | call_ext_last Ar Func D
+move S X0=x==0 | line Loc | call_ext_only Ar Func=u$is_not_bif => \
+ move S X0 | call_ext_only Ar Func
+move S X0=x==0 | line Loc | call Ar Func => \
+ line Loc | move S X0 | call Ar Func
line Loc | func_info M F A => func_info M F A | line Loc
@@ -167,31 +160,24 @@ is_tuple Fail=f S | select_tuple_arity S=d Fail=f Size=u Rest=* => \
select_tuple_arity S=d Fail=f Size=u Rest=* => \
gen_select_tuple_arity(S, Fail, Size, Rest)
-i_select_val_bins r f I
i_select_val_bins x f I
i_select_val_bins y f I
-i_select_val_lins r f I
i_select_val_lins x f I
i_select_val_lins y f I
-i_select_val2 r f c c f f
i_select_val2 x f c c f f
i_select_val2 y f c c f f
-i_select_tuple_arity r f I
i_select_tuple_arity x f I
i_select_tuple_arity y f I
-i_select_tuple_arity2 r f A A f f
i_select_tuple_arity2 x f A A f f
i_select_tuple_arity2 y f A A f f
-i_jump_on_val_zero r f I
i_jump_on_val_zero x f I
i_jump_on_val_zero y f I
-i_jump_on_val r f I I
i_jump_on_val x f I I
i_jump_on_val y f I I
@@ -203,30 +189,21 @@ is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \
%macro: get_list GetList -pack
get_list x x x
get_list x x y
-get_list x x r
get_list x y x
get_list x y y
-get_list x y r
-get_list x r x
-get_list x r y
get_list y x x
get_list y x y
-get_list y x r
get_list y y x
get_list y y y
-get_list y y r
-get_list y r x
-get_list y r y
+# The following get_list instructions using x(0) are frequently used.
get_list r x x
+get_list r r y
+get_list x r x
get_list r x y
-get_list r x r
-get_list r y x
-get_list r y y
get_list r y r
-get_list r r x
-get_list r r y
+get_list r x r
# Old-style catch.
catch y f
@@ -237,33 +214,31 @@ try Y F => catch Y F
try_case Y => try_end Y
try_end y
-try_case_end Literal=q => move Literal x | try_case_end x
try_case_end s
# Destructive set tuple element
-set_tuple_element Lit=q Tuple Pos => move Lit x | set_tuple_element x Tuple Pos
set_tuple_element s d P
# Get tuple element
%macro: i_get_tuple_element GetTupleElement -pack
i_get_tuple_element x P x
-i_get_tuple_element r P x
i_get_tuple_element y P x
-i_get_tuple_element x P r
-i_get_tuple_element y P r
%cold
-i_get_tuple_element r P r
i_get_tuple_element x P y
-i_get_tuple_element r P y
i_get_tuple_element y P y
%hot
+%macro: i_get_tuple_element2 GetTupleElement2 -pack
+i_get_tuple_element2 x P x
+
+%macro: i_get_tuple_element3 GetTupleElement3 -pack
+i_get_tuple_element3 x P x
+
%macro: is_number IsNumber -fail_action
%cold
-is_number f r
is_number f x
is_number f y
%hot
@@ -273,16 +248,12 @@ is_number Fail Literal=q => move Literal x | is_number Fail x
jump f
-case_end Literal=cq => move Literal x | case_end x
-badmatch Literal=cq => move Literal x | badmatch x
+case_end NotInX=cy => move NotInX x | case_end x
+badmatch NotInX=cy => move NotInX x | badmatch x
-case_end r
case_end x
-case_end y
-badmatch r
badmatch x
-badmatch y
if_end
raise s s
@@ -291,7 +262,7 @@ raise s s
badarg j
system_limit j
-move C=cxy r | jump Lbl => move_jump Lbl C
+move C=cxy x==0 | jump Lbl => move_jump Lbl C
%macro: move_jump MoveJump -nonext
move_jump f n
@@ -309,8 +280,6 @@ move_window/6
# x -> y
-move S1=r S2=y | move X1=x Y1=y => move2 S1 S2 X1 Y1
-
move X1=x Y1=y | move X2=x Y2=y | move X3=x Y3=y | succ(Y1,Y2) | succ(Y2,Y3) => \
move_window X1 X2 X3 Y1 Y3
@@ -323,24 +292,76 @@ move_window X1=x X2=x X3=x X4=x Y1=y Y4=y | move X5=x Y5=y | succ(Y4,Y5) => \
move_window X1=x X2=x X3=x Y1=y Y3=y => move_window3 X1 X2 X3 Y1
move_window X1=x X2=x X3=x X4=x Y1=y Y4=y => move_window4 X1 X2 X3 X4 Y1
+%macro: move_window3 MoveWindow3 -pack
+%macro: move_window4 MoveWindow4 -pack
+%macro: move_window5 MoveWindow5 -pack
+
move_window3 x x x y
move_window4 x x x x y
move_window5 x x x x x y
-move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2
-move Y1=y X1=x | move Y2=y X2=x => move2 Y1 X1 Y2 X2
-move X1=x X2=x | move X3=x X4=x => move2 X1 X2 X3 X4
+# Swap registers.
+move R1=x Tmp=x | move R2=xy R1 | move Tmp R2 => swap_temp R1 R2 Tmp
+
+swap_temp R1 R2 Tmp | line Loc | apply Live | is_killed(Tmp, Live) => \
+ swap R1 R2 | line Loc | apply Live
+
+swap_temp R1 R2 Tmp | line Loc | call Live Addr | is_killed(Tmp, Live) => \
+ swap R1 R2 | line Loc | call Live Addr
+swap_temp R1 R2 Tmp | call_only Live Addr | \
+ is_killed(Tmp, Live) => swap R1 R2 | call_only Live Addr
+swap_temp R1 R2 Tmp | call_last Live Addr D | \
+ is_killed(Tmp, Live) => swap R1 R2 | call_last Live Addr D
-move S1=x S2=r | move S3=x S4=x => move2 S1 S2 S3 S4
-move S1=x S2=r | move X1=x Y1=y => move2 S1 S2 X1 Y1
-move S1=y S2=r | move X1=x Y1=y => move2 S1 S2 X1 Y1
+swap_temp R1 R2 Tmp | line Loc | call_ext Live Addr | is_killed(Tmp, Live) => \
+ swap R1 R2 | line Loc | call_ext Live Addr
+swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \
+ is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_only Live Addr
+swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \
+ is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D
-move Y1=y X1=x | move S1=r D1=x => move2 Y1 X1 S1 D1
-move S1=r D1=x | move Y1=y X1=x => move2 S1 D1 Y1 X1
+%macro: swap_temp SwapTemp -pack
+swap_temp x x x
+swap_temp x y x
-move2 X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3
-move2 Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3
-move2 X1=x X2=x X3=x X4=x | move X5=x X6=x => move3 X1 X2 X3 X4 X5 X6
+%macro: swap Swap -pack
+swap x x
+swap x y
+
+move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2
+move Src=x SD=x | move SD=x D=x => move_dup Src SD D
+move Src=x D1=x | move Src=x D2=y => move_dup Src D1 D2
+move Src=y SD=x | move SD=x D=y => move_dup Src SD D
+move Src=x SD=x | move SD=x D=y => move_dup Src SD D
+move Src=y SD=x | move SD=x D=x => move_dup Src SD D
+
+move SD=x D=x | move Src=xy SD=x => move_shift Src SD D
+move SD=y D=x | move Src=x SD=y => move_shift Src SD D
+move SD=x D=y | move Src=x SD=x => move_shift Src SD D
+
+# The transformations above guarantee that the source for
+# the second move is not the same as the destination for
+# the first move. That means that we can do the moves in
+# parallel (fetch both values, then store them) which could
+# be faster.
+
+move X1=x Y1=y | move X2=x Y2=y => move2_par X1 Y1 X2 Y2
+move Y1=y X1=x | move Y2=y X2=x => move2_par Y1 X1 Y2 X2
+
+move X1=x X2=x | move X3=x X4=x => move2_par X1 X2 X3 X4
+
+move X1=x X2=x | move X3=x Y1=y => move2_par X1 X2 X3 Y1
+
+move S1=x S2=x | move X1=x Y1=y => move2_par S1 S2 X1 Y1
+
+move S1=y S2=x | move X1=x Y1=y => move2_par S1 S2 X1 Y1
+
+move Y1=y X1=x | move S1=x D1=x => move2_par Y1 X1 S1 D1
+move S1=x D1=x | move Y1=y X1=x => move2_par S1 D1 Y1 X1
+
+move2_par X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3
+move2_par Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3
+move2_par X1=x X2=x X3=x X4=x | move X5=x X6=x => move3 X1 X2 X3 X4 X5 X6
move C=aiq X=x==1 => move_x1 C
move C=aiq X=x==2 => move_x2 C
@@ -348,21 +369,32 @@ move C=aiq X=x==2 => move_x2 C
move_x1 c
move_x2 c
-%macro: move2 Move2 -pack
-move2 x y x y
-move2 y x y x
-move2 x x x x
+%macro: move_shift MoveShift -pack
+move_shift x x x
+move_shift y x x
+move_shift x y x
+move_shift x x y
+
+%macro: move_dup MoveDup -pack
+move_dup x x x
+move_dup x x y
+move_dup y x x
+move_dup y x y
-move2 x r x x
+%macro: move2_par Move2Par -pack
-move2 x r x y
-move2 r y x y
-move2 y r x y
+move2_par x y x y
+move2_par y x y x
+move2_par x x x x
-move2 r x y x
-move2 y x r x
+move2_par x x x y
-%macro: move3 Move3
+move2_par y x x y
+
+move2_par x x y x
+move2_par y x x x
+
+%macro: move3 Move3 -pack
move3 x y x y x y
move3 y x y x y x
move3 x x x x x x
@@ -375,20 +407,22 @@ move S=c D=y => move S x | move x D
%macro:move Move -pack -gen_dest
move x x
move x y
-move x r
move y x
-move y r
-move r x
-move r y
-move c r
move c x
move n x
-move n r
move y y
+# The following move instructions using x(0) are frequently used.
+
+move x r
+move r x
+move y r
+move c r
+move r y
+
# Receive operations.
-loop_rec Fail Src | smp_mark_target_label(Fail) => i_loop_rec Fail Src
+loop_rec Fail x==0 | smp_mark_target_label(Fail) => i_loop_rec Fail
label L | wait_timeout Fail Src | smp_already_locked(L) => label L | i_wait_timeout_locked Fail Src
wait_timeout Fail Src => i_wait_timeout Fail Src
@@ -403,7 +437,7 @@ label L | timeout | smp_already_locked(L) => label L | timeout_locked
remove_message
timeout
timeout_locked
-i_loop_rec f r
+i_loop_rec f
loop_rec_end f
wait f
wait_locked f
@@ -421,93 +455,57 @@ send
# Optimized comparisons with one immediate/literal operand.
#
-is_eq_exact Lbl R=rxy C=ian => i_is_eq_exact_immed Lbl R C
-is_eq_exact Lbl R=rxy C=q => i_is_eq_exact_literal R Lbl C
+is_eq_exact Lbl R=xy C=ian => i_is_eq_exact_immed Lbl R C
+is_eq_exact Lbl R=xy C=q => i_is_eq_exact_literal Lbl R C
-is_ne_exact Lbl R=rxy C=ian => i_is_ne_exact_immed Lbl R C
-is_ne_exact Lbl R=rxy C=q => i_is_ne_exact_literal R Lbl C
+is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C
+is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C
%macro: i_is_eq_exact_immed EqualImmed -fail_action
i_is_eq_exact_immed f r c
i_is_eq_exact_immed f x c
i_is_eq_exact_immed f y c
-i_is_eq_exact_literal r f c
-i_is_eq_exact_literal x f c
-i_is_eq_exact_literal y f c
+i_is_eq_exact_literal f x c
+i_is_eq_exact_literal f y c
%macro: i_is_ne_exact_immed NotEqualImmed -fail_action
-i_is_ne_exact_immed f r c
i_is_ne_exact_immed f x c
i_is_ne_exact_immed f y c
-i_is_ne_exact_literal r f c
-i_is_ne_exact_literal x f c
-i_is_ne_exact_literal y f c
+i_is_ne_exact_literal f x c
+i_is_ne_exact_literal f y c
-#
-# Common Compare Specializations
-# We don't do all of them since we want
-# to keep the instruction set small-ish
-#
-
-is_eq_exact Lbl S1=xy S2=r => is_eq_exact Lbl S2 S1
-is_eq_exact Lbl S1=rx S2=xy => i_is_eq_exact_spec Lbl S1 S2
-%macro: i_is_eq_exact_spec EqualExact -fail_action
+is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y
+%macro: is_eq_exact EqualExact -fail_action -pack
+is_eq_exact f x x
+is_eq_exact f x y
+is_eq_exact f s s
-i_is_eq_exact_spec f x x
-i_is_eq_exact_spec f x y
-i_is_eq_exact_spec f r x
-i_is_eq_exact_spec f r y
+%macro: is_lt IsLessThan -fail_action
+is_lt f x x
+is_lt f x c
+is_lt f c x
%cold
-i_is_eq_exact_spec f r r
+is_lt f s s
%hot
-is_lt Lbl S1=rxc S2=rxc => i_is_lt_spec Lbl S1 S2
-
-%macro: i_is_lt_spec IsLessThan -fail_action
-
-i_is_lt_spec f x x
-i_is_lt_spec f x r
-i_is_lt_spec f x c
-i_is_lt_spec f r x
-i_is_lt_spec f r c
-i_is_lt_spec f c x
-i_is_lt_spec f c r
+%macro: is_ge IsGreaterEqual -fail_action
+is_ge f x x
+is_ge f x c
+is_ge f c x
%cold
-i_is_lt_spec f r r
-i_is_lt_spec f c c
+is_ge f s s
%hot
-is_ge Lbl S1=xc S2=xc => i_is_ge_spec Lbl S1 S2
-
-%macro: i_is_ge_spec IsGreaterEqual -fail_action
-
-i_is_ge_spec f x x
-i_is_ge_spec f x c
-i_is_ge_spec f c x
-%cold
-i_is_ge_spec f c c
-%hot
-
-#
-# All other comparisons.
-#
-
-is_eq_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_eq_exact Lbl
-is_ne_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_ne_exact Lbl
+%macro: is_ne_exact NotEqualExact -fail_action
+is_ne_exact f s s
-is_lt Lbl S1 S2 => i_fetch S1 S2 | i_is_lt Lbl
-is_ge Lbl S1 S2 => i_fetch S1 S2 | i_is_ge Lbl
-is_eq Lbl S1 S2 => i_fetch S1 S2 | i_is_eq Lbl
-is_ne Lbl S1 S2 => i_fetch S1 S2 | i_is_ne Lbl
+%macro: is_eq Equal -fail_action
+is_eq f s s
-i_is_eq_exact f
-i_is_ne_exact f
-i_is_lt f
-i_is_ge f
-i_is_eq f
-i_is_ne f
+%macro: is_ne NotEqual -fail_action
+is_ne f s s
#
# Putting things.
@@ -525,7 +523,6 @@ i_put_tuple Dst Arity Puts=* | put S => \
i_put_tuple/2
%macro:i_put_tuple PutTuple -pack -goto:do_put_tuple
-i_put_tuple r I
i_put_tuple x I
i_put_tuple y I
@@ -542,74 +539,36 @@ put_list x n x
put_list y n x
put_list x x x
put_list y x x
-put_list x x r
-put_list y r r
put_list y y x
put_list x y x
-put_list r x x
-put_list r y x
-put_list r x r
-put_list y y r
-put_list y r x
-put_list r n x
-put_list x r x
-put_list x y r
-put_list y x r
put_list y x x
-put_list x r r
-
# put_list SrcReg Constant Dst
-put_list r c r
-put_list r c x
-put_list r c y
-put_list x c r
put_list x c x
put_list x c y
-put_list y c r
put_list y c x
-put_list y c y
# put_list Constant SrcReg Dst
-put_list c r r
-put_list c r x
-put_list c r y
-put_list c x r
put_list c x x
-put_list c x y
-
-put_list c y r
put_list c y x
-put_list c y y
-%cold
-put_list s s d
-%hot
+# The following put_list instructions using x(0) are frequently used.
-%macro: i_fetch FetchArgs -pack
-i_fetch c r
-i_fetch c x
-i_fetch c y
-i_fetch r c
-i_fetch r x
-i_fetch r y
-i_fetch x c
-i_fetch x r
-i_fetch x x
-i_fetch x y
-i_fetch y c
-i_fetch y r
-i_fetch y x
-i_fetch y y
+put_list y r r
+put_list x r r
+put_list r n r
+put_list r n x
+put_list r x x
+put_list r x r
+put_list x x r
%cold
-i_fetch c c
-i_fetch s s
+put_list s s d
%hot
#
@@ -631,27 +590,27 @@ return_trace
# Note: There is no 'move_return y r', since there never are any y registers
# when we do move_return (if we have y registers, we must do move_deallocate_return).
-move S r | return => move_return S r
+move S x==0 | return => move_return S
%macro: move_return MoveReturn -nonext
-move_return x r
-move_return c r
-move_return n r
+move_return x
+move_return c
+move_return n
-move S r | deallocate D | return => move_deallocate_return S r D
+move S x==0 | deallocate D | return => move_deallocate_return S D
%macro: move_deallocate_return MoveDeallocateReturn -pack -nonext
-move_deallocate_return x r Q
-move_deallocate_return y r Q
-move_deallocate_return c r Q
-move_deallocate_return n r Q
+move_deallocate_return x Q
+move_deallocate_return y Q
+move_deallocate_return c Q
+move_deallocate_return n Q
deallocate D | return => deallocate_return D
%macro: deallocate_return DeallocateReturn -nonext
deallocate_return Q
-test_heap Need u==1 | put_list Y=y r r => test_heap_1_put_list Need Y
+test_heap Need u==1 | put_list Y=y x==0 x==0 => test_heap_1_put_list Need Y
%macro: test_heap_1_put_list TestHeapPutList -pack
test_heap_1_put_list I y
@@ -660,18 +619,18 @@ test_heap_1_put_list I y
is_tuple Fail Literal=q => move Literal x | is_tuple Fail x
is_tuple Fail=f c => jump Fail
-is_tuple Fail=f S=rxy | test_arity Fail=f S=rxy Arity => is_tuple_of_arity Fail S Arity
+is_tuple Fail=f S=xy | test_arity Fail=f S=xy Arity => is_tuple_of_arity Fail S Arity
%macro:is_tuple_of_arity IsTupleOfArity -fail_action
+is_tuple_of_arity f r A
is_tuple_of_arity f x A
is_tuple_of_arity f y A
-is_tuple_of_arity f r A
%macro: is_tuple IsTuple -fail_action
+is_tuple f r
is_tuple f x
is_tuple f y
-is_tuple f r
test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity
test_arity Fail=f c Arity => jump Fail
@@ -679,95 +638,63 @@ test_arity Fail=f c Arity => jump Fail
%macro: test_arity IsArity -fail_action
test_arity f x A
test_arity f y A
-test_arity f r A
-
-is_tuple_of_arity Fail=f Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \
- is_tuple_of_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P
-
-test_arity Fail Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \
- test_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P
-
-original_reg Reg P1 | get_tuple_element Reg P2 Dst=xy | succ(P1, P2) => \
- extract_next_element Dst | original_reg Reg P2
-
-get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg P
-
-original_reg Reg Pos =>
-original_reg/2
+get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
+ get_tuple_element Reg=x P3 D3=x | \
+ succ(P1, P2) | succ(P2, P3) | \
+ succ(D1, D2) | succ(D2, D3) => i_get_tuple_element3 Reg P1 D1
-extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \
-succ(P1, P2) | succ(D1, D2) => \
- extract_next_element2 D1 | original_reg Reg P2
+get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
+ succ(P1, P2) | succ(D1, D2) => i_get_tuple_element2 Reg P1 D1
-extract_next_element2 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \
-succ(P1, P2) | succ2(D1, D2) => \
- extract_next_element3 D1 | original_reg Reg P2
-
-#extract_next_element3 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \
-#succ(P1, P2) | succ3(D1, D2) => \
-# extract_next_element4 D1 | original_reg Reg P2
-
-%macro: extract_next_element ExtractNextElement -pack
-extract_next_element x
-extract_next_element y
-
-%macro: extract_next_element2 ExtractNextElement2 -pack
-extract_next_element2 x
-extract_next_element2 y
-
-%macro: extract_next_element3 ExtractNextElement3 -pack
-extract_next_element3 x
-extract_next_element3 y
-
-#%macro: extract_next_element4 ExtractNextElement4 -pack
-#extract_next_element4 x
-#extract_next_element4 y
+get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst
is_integer Fail=f i =>
is_integer Fail=f an => jump Fail
is_integer Fail Literal=q => move Literal x | is_integer Fail x
-is_integer Fail=f S=rx | allocate Need Regs => is_integer_allocate Fail S Need Regs
+is_integer Fail=f S=x | allocate Need Regs => is_integer_allocate Fail S Need Regs
%macro: is_integer_allocate IsIntegerAllocate -fail_action
is_integer_allocate f x I I
-is_integer_allocate f r I I
%macro: is_integer IsInteger -fail_action
is_integer f x
is_integer f y
-is_integer f r
is_list Fail=f n =>
is_list Fail Literal=q => move Literal x | is_list Fail x
is_list Fail=f c => jump Fail
%macro: is_list IsList -fail_action
-is_list f r
is_list f x
%cold
is_list f y
%hot
-is_nonempty_list Fail=f S=rx | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs
+is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs
%macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -pack
-is_nonempty_list_allocate f x I t
is_nonempty_list_allocate f r I t
+is_nonempty_list_allocate f x I t
-is_nonempty_list F=f r | test_heap I1 I2 => is_non_empty_list_test_heap F r I1 I2
+is_nonempty_list F=f x==0 | test_heap I1 I2 => is_non_empty_list_test_heap F I1 I2
%macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -pack
-is_non_empty_list_test_heap f r I t
+is_non_empty_list_test_heap f I t
+
+is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \
+ is_nonempty_list_get_list Fail S D1 D2
+
+%macro: is_nonempty_list_get_list IsNonemptyListGetList -fail_action -pack
+is_nonempty_list_get_list f r x x
+is_nonempty_list_get_list f x x x
%macro: is_nonempty_list IsNonemptyList -fail_action
is_nonempty_list f x
is_nonempty_list f y
-is_nonempty_list f r
%macro: is_atom IsAtom -fail_action
is_atom f x
-is_atom f r
%cold
is_atom f y
%hot
@@ -775,7 +702,6 @@ is_atom Fail=f a =>
is_atom Fail=f niq => jump Fail
%macro: is_float IsFloat -fail_action
-is_float f r
is_float f x
%cold
is_float f y
@@ -789,12 +715,10 @@ is_nil Fail=f qia => jump Fail
%macro: is_nil IsNil -fail_action
is_nil f x
is_nil f y
-is_nil f r
is_binary Fail Literal=q => move Literal x | is_binary Fail x
is_binary Fail=f c => jump Fail
%macro: is_binary IsBinary -fail_action
-is_binary f r
is_binary f x
%cold
is_binary f y
@@ -806,7 +730,6 @@ is_bitstr Fail Term => is_bitstring Fail Term
is_bitstring Fail Literal=q => move Literal x | is_bitstring Fail x
is_bitstring Fail=f c => jump Fail
%macro: is_bitstring IsBitstring -fail_action
-is_bitstring f r
is_bitstring f x
%cold
is_bitstring f y
@@ -814,7 +737,6 @@ is_bitstring f y
is_reference Fail=f cq => jump Fail
%macro: is_reference IsRef -fail_action
-is_reference f r
is_reference f x
%cold
is_reference f y
@@ -822,7 +744,6 @@ is_reference f y
is_pid Fail=f cq => jump Fail
%macro: is_pid IsPid -fail_action
-is_pid f r
is_pid f x
%cold
is_pid f y
@@ -830,7 +751,6 @@ is_pid f y
is_port Fail=f cq => jump Fail
%macro: is_port IsPort -fail_action
-is_port f r
is_port f x
%cold
is_port f y
@@ -842,14 +762,12 @@ is_boolean Fail=f ac => jump Fail
%cold
%macro: is_boolean IsBoolean -fail_action
-is_boolean f r
is_boolean f x
is_boolean f y
%hot
is_function2 Fail=f acq Arity => jump Fail
is_function2 Fail=f Fun a => jump Fail
-is_function2 Fail Fun Literal=q => move Literal x | is_function2 Fail Fun x
is_function2 f s s
%macro: is_function2 IsFunction2 -fail_action
@@ -989,76 +907,76 @@ call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate
%unless USE_VM_PROBES
call_ext Arity u$func:erlang:dt_get_tag/0 => \
- move a=am_undefined r
+ move a=am_undefined x=0
call_ext_last Arity u$func:erlang:dt_get_tag/0 D => \
- move a=am_undefined r | deallocate D | return
+ move a=am_undefined x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_get_tag/0 => \
- move a=am_undefined r | return
-
-move Any r | call_ext Arity u$func:erlang:dt_put_tag/1 => \
- move a=am_undefined r
-move Any r | call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \
- move a=am_undefined r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_put_tag/1 => \
- move a=am_undefined r | return
+ move a=am_undefined x=0 | return
+
+move Any x==0 | call_ext Arity u$func:erlang:dt_put_tag/1 => \
+ move a=am_undefined x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \
+ move a=am_undefined x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_put_tag/1 => \
+ move a=am_undefined x=0 | return
call_ext Arity u$func:erlang:dt_put_tag/1 => \
- move a=am_undefined r
+ move a=am_undefined x=0
call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \
- move a=am_undefined r | deallocate D | return
+ move a=am_undefined x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_put_tag/1 => \
- move a=am_undefined r | return
+ move a=am_undefined x=0 | return
call_ext Arity u$func:erlang:dt_get_tag_data/0 => \
- move a=am_undefined r
+ move a=am_undefined x=0
call_ext_last Arity u$func:erlang:dt_get_tag_data/0 D => \
- move a=am_undefined r | deallocate D | return
+ move a=am_undefined x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_get_tag_data/0 => \
- move a=am_undefined r | return
-
-move Any r | call_ext Arity u$func:erlang:dt_spread_tag/1 => \
- move a=am_true r
-move Any r | call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \
- move a=am_true r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \
- move a=am_true r | return
+ move a=am_undefined x=0 | return
+
+move Any x==0 | call_ext Arity u$func:erlang:dt_spread_tag/1 => \
+ move a=am_true x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \
+ move a=am_true x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \
+ move a=am_true x=0 | return
call_ext Arity u$func:erlang:dt_spread_tag/1 => \
- move a=am_true r
+ move a=am_true x=0
call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \
- move a=am_true r | deallocate D | return
+ move a=am_true x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \
- move a=am_true r | return
-
-move Any r | call_ext Arity u$func:erlang:dt_restore_tag/1 => \
- move a=am_true r
-move Any r | call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \
- move a=am_true r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \
- move a=am_true r | return
+ move a=am_true x=0 | return
+
+move Any x==0 | call_ext Arity u$func:erlang:dt_restore_tag/1 => \
+ move a=am_true x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \
+ move a=am_true x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \
+ move a=am_true x=0 | return
call_ext Arity u$func:erlang:dt_restore_tag/1 => \
- move a=am_true r
+ move a=am_true x=0
call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \
- move a=am_true r | deallocate D | return
+ move a=am_true x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \
- move a=am_true r | return
-
-move Any r | call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
- move Any r
-move Any r | call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \
- move Any r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
- move Any r | return
+ move a=am_true x=0 | return
+
+move Any x==0 | call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
+ move Any x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \
+ move Any x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
+ move Any x=0 | return
call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 =>
call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \
deallocate D | return
call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
return
-move Any r | call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => \
- move Any r
-move Any r | call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \
- move Any r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \
- move Any r | return
+move Any x==0 | call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => \
+ move Any x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \
+ move Any x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \
+ move Any x=0 | return
call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 =>
call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \
deallocate D | return
@@ -1066,10 +984,17 @@ call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \
return
# Can happen after one of the transformations above.
-move Discarded r | move Something r => move Something r
+move Discarded x==0 | move Something x==0 => move Something x=0
%endif
+call_ext u==0 u$func:os:perf_counter/0 => \
+ i_perf_counter
+call_ext_last u==0 u$func:os:perf_counter/0 D => \
+ i_perf_counter | deallocate_return D
+call_ext_only u==0 u$func:os:perf_counter/0 => \
+ i_perf_counter | return
+
#
# The general case for BIFs that have no special instructions.
# A BIF used in the tail must be followed by a return instruction.
@@ -1091,9 +1016,9 @@ call_ext_only Ar=u Bif=u$is_bif => \
# with call instructions.
#
-move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func
-move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r
-move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r
+move S=c x==0 | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S Func
+move S=c x==0 | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S
+move S=c x==0 | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S
call_ext Ar Func => i_call_ext Func
call_ext_last Ar Func D => i_call_ext_last Func D
@@ -1109,6 +1034,8 @@ i_apply_fun_only
i_hibernate
+i_perf_counter
+
call_bif e
#
@@ -1118,80 +1045,74 @@ call_bif e
bif0 u$bif:erlang:self/0 Dst=d => self Dst
bif0 u$bif:erlang:node/0 Dst=d => node Dst
-bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => i_get Src Dst
+bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => gen_get(Src, Dst)
-bif2 Jump=j u$bif:erlang:element/2 S1=s S2=rxy Dst=d => gen_element(Jump, S1, S2, Dst)
+bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => gen_element(Jump, S1, S2, Dst)
-bif1 Fail Bif Literal=q Dst => move Literal x | bif1 Fail Bif x Dst
bif1 p Bif S1 Dst => bif1_body Bif S1 Dst
-bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst
-
-bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst
-bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst
+bif2 p Bif S1 S2 Dst => i_bif2_body Bif S1 S2 Dst
+bif2 Fail Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst
+i_get_hash c I d
i_get s d
%macro: self Self
-self r
self x
self y
%macro: node Node
-node r
node x
%cold
node y
%hot
-i_fast_element r j I d
-i_fast_element x j I d
-i_fast_element y j I d
+i_fast_element j x I d
+i_fast_element j y I d
-i_element r j s d
-i_element x j s d
-i_element y j s d
+i_element j x s d
+i_element j y s d
bif1 f b s d
bif1_body b s d
-i_bif2 f b d
-i_bif2_body b d
+i_bif2 f b s s d
+i_bif2_body b s s d
#
# Internal calls.
#
-move S=c r | call Ar P=f => i_move_call S r P
-move S=s r | call Ar P=f => move_call S r P
+move S=c x==0 | call Ar P=f => i_move_call S P
+move S=s x==0 | call Ar P=f => move_call S P
-i_move_call c r f
+i_move_call c f
%macro:move_call MoveCall -arg_f -size -nonext
-move_call/3
+move_call/2
-move_call x r f
-move_call y r f
+move_call x f
+move_call y f
-move S=c r | call_last Ar P=f D => i_move_call_last P D S r
-move S r | call_last Ar P=f D => move_call_last S r P D
+move S=c x==0 | call_last Ar P=f D => i_move_call_last P D S
+move S x==0 | call_last Ar P=f D => move_call_last S P D
-i_move_call_last f P c r
+i_move_call_last f P c
%macro:move_call_last MoveCallLast -arg_f -nonext -pack
-move_call_last/4
-move_call_last x r f Q
-move_call_last y r f Q
+move_call_last/3
+move_call_last x f Q
+move_call_last y f Q
-move S=c r | call_only Ar P=f => i_move_call_only P S r
-move S=x r | call_only Ar P=f => move_call_only S r P
+move S=c x==0 | call_only Ar P=f => i_move_call_only P S
+move S=x x==0 | call_only Ar P=f => move_call_only S P
-i_move_call_only f c r
+i_move_call_only f c
%macro:move_call_only MoveCallOnly -arg_f -nonext
-move_call_only/3
+move_call_only/2
-move_call_only x r f
+move_call_only x f
call Ar Func => i_call Func
call_last Ar Func D => i_call_last Func D
@@ -1205,9 +1126,9 @@ i_call_ext e
i_call_ext_last e P
i_call_ext_only e
-i_move_call_ext c r e
-i_move_call_ext_last e P c r
-i_move_call_ext_only e c r
+i_move_call_ext c e
+i_move_call_ext_last e P c
+i_move_call_ext_only e c
# Fun calls.
@@ -1227,7 +1148,6 @@ i_make_fun I t
%macro: is_function IsFunction -fail_action
is_function f x
is_function f y
-is_function f r
is_function Fail=f c => jump Fail
func_info M F A => i_func_info u M F A
@@ -1239,131 +1159,105 @@ func_info M F A => i_func_info u M F A
%cold
bs_start_match2 Fail=f ica X Y D => jump Fail
bs_start_match2 Fail Bin X Y D => i_bs_start_match2 Bin Fail X Y D
-i_bs_start_match2 r f I I d
i_bs_start_match2 x f I I d
i_bs_start_match2 y f I I d
bs_save2 Reg Index => gen_bs_save(Reg, Index)
-i_bs_save2 r I
i_bs_save2 x I
bs_restore2 Reg Index => gen_bs_restore(Reg, Index)
-i_bs_restore2 r I
i_bs_restore2 x I
# Matching integers
bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val
-i_bs_match_string r f I I
i_bs_match_string x f I I
# Fetching integers from binaries.
-bs_get_integer2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \
+bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \
gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
-i_bs_get_integer_small_imm r I f I d
i_bs_get_integer_small_imm x I f I d
-i_bs_get_integer_imm r I I f I d
i_bs_get_integer_imm x I I f I d
-i_bs_get_integer f I I d
-i_bs_get_integer_8 r f d
+i_bs_get_integer f I I s s d
i_bs_get_integer_8 x f d
-i_bs_get_integer_16 r f d
i_bs_get_integer_16 x f d
-i_bs_get_integer_32 r f I d
i_bs_get_integer_32 x f I d
# Fetching binaries from binaries.
-bs_get_binary2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \
+bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \
gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
%macro: i_bs_get_binary_imm2 BsGetBinaryImm_2 -fail_action -gen_dest
%macro: i_bs_get_binary2 BsGetBinary_2 -fail_action -gen_dest
%macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action -gen_dest
-i_bs_get_binary_imm2 f r I I I d
i_bs_get_binary_imm2 f x I I I d
-i_bs_get_binary2 f r I s I d
i_bs_get_binary2 f x I s I d
-i_bs_get_binary_all2 f r I I d
i_bs_get_binary_all2 f x I I d
-i_bs_get_binary_all_reuse r f I
i_bs_get_binary_all_reuse x f I
# Fetching float from binaries.
-bs_get_float2 Fail=f Ms=rx Live=u Sz=s Unit=u Flags=u Dst=d => \
+bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \
gen_get_float2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
-bs_get_float2 Fail=f Ms=rx Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail
+bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail
%macro: i_bs_get_float2 BsGetFloat2 -fail_action -gen_dest
-i_bs_get_float2 f r I s I d
i_bs_get_float2 f x I s I d
# Miscellanous
-bs_skip_bits2 Fail=f Ms=rx Sz=s Unit=u Flags=u => \
- gen_skip_bits2(Fail, Ms, Sz, Unit, Flags)
-bs_skip_bits2 Fail=f Ms=rx Sz=q Unit=u Flags=u => \
+bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \
gen_skip_bits2(Fail, Ms, Sz, Unit, Flags)
%macro: i_bs_skip_bits_imm2 BsSkipBitsImm2 -fail_action
-i_bs_skip_bits_imm2 f r I
i_bs_skip_bits_imm2 f x I
%macro: i_bs_skip_bits2 BsSkipBits2 -fail_action
-i_bs_skip_bits2 f r x I
-i_bs_skip_bits2 f r y I
i_bs_skip_bits2 f x x I
-i_bs_skip_bits2 f x r I
i_bs_skip_bits2 f x y I
%macro: i_bs_skip_bits_all2 BsSkipBitsAll2 -fail_action
-i_bs_skip_bits_all2 f r I
i_bs_skip_bits_all2 f x I
-bs_test_tail2 Fail=f Ms=rx Bits=u==0 => bs_test_zero_tail2 Fail Ms
-bs_test_tail2 Fail=f Ms=rx Bits=u => bs_test_tail_imm2 Fail Ms Bits
-bs_test_zero_tail2 f r
+bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms
+bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits
bs_test_zero_tail2 f x
-bs_test_tail_imm2 f r I
bs_test_tail_imm2 f x I
bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms
-bs_test_unit f r I
bs_test_unit f x I
-bs_test_unit8 f r
bs_test_unit8 f x
-bs_context_to_binary r
+# An y register operand for bs_context_to_binary is rare,
+# but can happen because of inlining.
+
+bs_context_to_binary Y=y => move Y x | bs_context_to_binary x
+
bs_context_to_binary x
-bs_context_to_binary y
#
# Utf8/utf16/utf32 support. (R12B-5)
#
-bs_get_utf8 Fail=f Ms=rx u u Dst=d => i_bs_get_utf8 Ms Fail Dst
-i_bs_get_utf8 r f d
+bs_get_utf8 Fail=f Ms=x u u Dst=d => i_bs_get_utf8 Ms Fail Dst
i_bs_get_utf8 x f d
-bs_skip_utf8 Fail=f Ms=rx u u => i_bs_get_utf8 Ms Fail x
+bs_skip_utf8 Fail=f Ms=x u u => i_bs_get_utf8 Ms Fail x
-bs_get_utf16 Fail=f Ms=rx u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst
-bs_skip_utf16 Fail=f Ms=rx u Flags=u => i_bs_get_utf16 Ms Fail Flags x
+bs_get_utf16 Fail=f Ms=x u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst
+bs_skip_utf16 Fail=f Ms=x u Flags=u => i_bs_get_utf16 Ms Fail Flags x
-i_bs_get_utf16 r f I d
i_bs_get_utf16 x f I d
-bs_get_utf32 Fail=f Ms=rx Live=u Flags=u Dst=d => \
+bs_get_utf32 Fail=f Ms=x Live=u Flags=u Dst=d => \
bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \
- i_fetch Dst Ms | \
- i_bs_validate_unicode_retract Fail
-bs_skip_utf32 Fail=f Ms=rx Live=u Flags=u => \
+ i_bs_validate_unicode_retract Fail Dst Ms
+bs_skip_utf32 Fail=f Ms=x Live=u Flags=u => \
bs_get_integer2 Fail Ms Live i=32 u=1 Flags x | \
- i_fetch x Ms | \
- i_bs_validate_unicode_retract Fail
+ i_bs_validate_unicode_retract Fail x Ms
-i_bs_validate_unicode_retract j
+i_bs_validate_unicode_retract j s s
%hot
#
@@ -1385,13 +1279,12 @@ bs_init2 Fail Sz=u Words Regs Flags Dst => \
bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \
i_bs_init_fail Sz Fail Regs Dst
bs_init2 Fail Sz Words Regs Flags Dst => \
- i_fetch Sz r | i_bs_init_fail_heap Words Fail Regs Dst
+ i_bs_init_fail_heap Sz Words Fail Regs Dst
-i_bs_init_fail r j I d
i_bs_init_fail x j I d
i_bs_init_fail y j I d
-i_bs_init_fail_heap I j I d
+i_bs_init_fail_heap s I j I d
i_bs_init I I d
i_bs_init_heap_bin I I d
@@ -1408,39 +1301,35 @@ bs_init_bits Fail Sz=u Words Regs Flags Dst => i_bs_init_bits_heap Sz Words Reg
bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \
i_bs_init_bits_fail Sz Fail Regs Dst
bs_init_bits Fail Sz Words Regs Flags Dst => \
- i_fetch Sz r | i_bs_init_bits_fail_heap Words Fail Regs Dst
+ i_bs_init_bits_fail_heap Sz Words Fail Regs Dst
-i_bs_init_bits_fail r j I d
i_bs_init_bits_fail x j I d
i_bs_init_bits_fail y j I d
-i_bs_init_bits_fail_heap I j I d
+i_bs_init_bits_fail_heap s I j I d
i_bs_init_bits I I d
i_bs_init_bits_heap I I I d
bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D
-bs_add Fail S1 S2 Unit D => i_fetch S1 S2 | i_bs_add Fail Unit D
-i_bs_add j I d
+bs_add j s s I d
bs_append Fail Size Extra Live Unit Bin Flags Dst => \
- i_fetch Size Bin | i_bs_append Fail Extra Live Unit Dst
+ move Bin x | i_bs_append Fail Extra Live Unit Size Dst
bs_private_append Fail Size Unit Bin Flags Dst => \
- i_fetch Size Bin | i_bs_private_append Fail Unit Dst
+ i_bs_private_append Fail Unit Size Bin Dst
bs_init_writable
-i_bs_append j I I I d
-i_bs_private_append j I d
+i_bs_append j I I I s d
+i_bs_private_append j I s s d
#
# Storing integers into binaries.
#
-bs_put_integer Fail=j Sz=s Unit=u Flags=u Literal=q => \
- move Literal x | bs_put_integer Fail Sz Unit Flags x
bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \
gen_put_integer(Fail, Sz, Unit, Flags, Src)
@@ -1454,32 +1343,22 @@ i_new_bs_put_integer_imm j I I s
# Utf8/utf16/utf32 support. (R12B-5)
#
-bs_utf8_size Fail Literal=q Dst=d => \
- move Literal x | bs_utf8_size Fail x Dst
bs_utf8_size j Src=s Dst=d => i_bs_utf8_size Src Dst
i_bs_utf8_size s d
-bs_utf16_size Fail Literal=q Dst=d => \
- move Literal x | bs_utf16_size Fail x Dst
bs_utf16_size j Src=s Dst=d => i_bs_utf16_size Src Dst
i_bs_utf16_size s d
-bs_put_utf8 Fail=j Flags=u Literal=q => \
- move Literal x | bs_put_utf8 Fail Flags x
bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src
i_bs_put_utf8 j s
-bs_put_utf16 Fail=j Flags=u Literal=q => \
- move Literal x | bs_put_utf16 Fail Flags x
bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src
i_bs_put_utf16 j I s
-bs_put_utf32 Fail=j Flags=u Literal=q => \
- move Literal x | bs_put_utf32 Fail Flags x
bs_put_utf32 Fail=j Flags=u Src=s => \
i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src
@@ -1490,9 +1369,6 @@ i_bs_validate_unicode j s
#
bs_put_float Fail Sz=q Unit Flags Val => badarg Fail
-bs_put_float Fail=j Sz Unit=u Flags=u Literal=q => \
- move Literal x | bs_put_float Fail Sz Unit Flags x
-
bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_float(Fail, Sz, Unit, Flags, Src)
@@ -1506,8 +1382,6 @@ i_new_bs_put_float_imm j I I s
# Storing binaries into binaries.
#
-bs_put_binary Fail Sz Unit Flags Literal=q => \
- move Literal x | bs_put_binary Fail Sz Unit Flags x
bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_binary(Fail, Sz, Unit, Flags, Src)
@@ -1600,7 +1474,6 @@ is_map Fail Lit=q | literal_is_map(Lit) =>
is_map Fail cq => jump Fail
%macro: is_map IsMap -fail_action
-is_map f r
is_map f x
is_map f y
@@ -1611,101 +1484,120 @@ has_map_fields Fail Src Size Rest=* => \
## Transform get_map_elements(s) #{ K1 := V1, K2 := V2 }
-get_map_elements Fail Src=rxy Size=u==2 Rest=* => \
+get_map_elements Fail Src=xy Size=u==2 Rest=* => \
gen_get_map_element(Fail, Src, Size, Rest)
get_map_elements Fail Src Size Rest=* | map_key_sort(Size, Rest) => \
gen_get_map_elements(Fail, Src, Size, Rest)
i_get_map_elements f s I
-i_get_map_element Fail Src=rxy Key=ry Dst => \
+i_get_map_element Fail Src=xy Key=y Dst => \
move Key x | i_get_map_element Fail Src x Dst
%macro: i_get_map_element_hash GetMapElementHash -fail_action
-i_get_map_element_hash f r c I r
-i_get_map_element_hash f x c I r
-i_get_map_element_hash f y c I r
-i_get_map_element_hash f r c I x
i_get_map_element_hash f x c I x
i_get_map_element_hash f y c I x
-i_get_map_element_hash f r c I y
i_get_map_element_hash f x c I y
i_get_map_element_hash f y c I y
%macro: i_get_map_element GetMapElement -fail_action
-i_get_map_element f r x r
-i_get_map_element f x x r
-i_get_map_element f y x r
-i_get_map_element f r x x
i_get_map_element f x x x
i_get_map_element f y x x
-i_get_map_element f r x y
i_get_map_element f x x y
i_get_map_element f y x y
#
+# Convert the plus operations to a generic plus instruction.
+#
+gen_plus/5
+gen_minus/5
+
+gc_bif1 Fail Live u$bif:erlang:splus/1 Src Dst => \
+ gen_plus Fail Live Src i Dst
+gc_bif2 Fail Live u$bif:erlang:splus/2 S1 S2 Dst => \
+ gen_plus Fail Live S1 S2 Dst
+
+gc_bif1 Fail Live u$bif:erlang:sminus/1 Src Dst => \
+ gen_minus Fail Live i Src Dst
+gc_bif2 Fail Live u$bif:erlang:sminus/2 S1 S2 Dst => \
+ gen_minus Fail Live S1 S2 Dst
+
+#
# Optimize addition and subtraction of small literals using
# the i_increment/4 instruction (in bodies, not in guards).
#
-gc_bif2 p Live u$bif:erlang:splus/2 Int=i Reg=d Dst => \
+gen_plus p Live Int=i Reg=d Dst => \
gen_increment(Reg, Int, Live, Dst)
-gc_bif2 p Live u$bif:erlang:splus/2 Reg=d Int=i Dst => \
+gen_plus p Live Reg=d Int=i Dst => \
gen_increment(Reg, Int, Live, Dst)
-gc_bif2 p Live u$bif:erlang:sminus/2 Reg=d Int=i Dst | \
- negation_is_small(Int) => \
+gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \
gen_increment_from_minus(Reg, Int, Live, Dst)
#
# GCing arithmetic instructions.
#
-gc_bif2 Fail I u$bif:erlang:splus/2 S1=x S2=x Dst=d => i_plus Fail I S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:splus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_plus Fail I Dst
-gc_bif2 Fail I u$bif:erlang:sminus/2 S1=x S2=x Dst=d => i_minus Fail I S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:sminus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_minus Fail I Dst
-gc_bif2 Fail I u$bif:erlang:stimes/2 S1 S2 Dst=d => i_fetch S1 S2 | i_times Fail I Dst
-gc_bif2 Fail I u$bif:erlang:div/2 S1 S2 Dst=d => i_fetch S1 S2 | i_m_div Fail I Dst
+gen_plus Fail Live Y=y X=x Dst => i_plus Fail Live X Y Dst
+gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:intdiv/2 S1 S2 Dst=d => i_fetch S1 S2 | i_int_div Fail I Dst
-gc_bif2 Fail I u$bif:erlang:rem/2 S1=x S2=x Dst=d => i_rem Fail I S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:rem/2 S1 S2 Dst=d => i_fetch S1 S2 | i_rem Fail I Dst
+gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:bsl/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsl Fail I Dst
-gc_bif2 Fail I u$bif:erlang:bsr/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsr Fail I Dst
+gc_bif2 Fail Live u$bif:erlang:stimes/2 S1 S2 Dst => \
+ i_times Fail Live S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:band/2 S1=x S2=c Dst=d => i_band Fail I S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:band/2 S1 S2 Dst=d => i_fetch S1 S2 | i_band Fail I Dst
-gc_bif2 Fail I u$bif:erlang:bor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bor Fail I Dst
-gc_bif2 Fail I u$bif:erlang:bxor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bxor Fail I Dst
+gc_bif2 Fail Live u$bif:erlang:div/2 S1 S2 Dst => \
+ i_m_div Fail Live S1 S2 Dst
+gc_bif2 Fail Live u$bif:erlang:intdiv/2 S1 S2 Dst => \
+ i_int_div Fail Live S1 S2 Dst
-gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst
+gc_bif2 Fail Live u$bif:erlang:rem/2 S1 S2 Dst => \
+ i_rem Fail Live S1 S2 Dst
+
+gc_bif2 Fail Live u$bif:erlang:bsl/2 S1 S2 Dst => \
+ i_bsl Fail Live S1 S2 Dst
+gc_bif2 Fail Live u$bif:erlang:bsr/2 S1 S2 Dst => \
+ i_bsr Fail Live S1 S2 Dst
+
+gc_bif2 Fail Live u$bif:erlang:band/2 S1 S2 Dst => \
+ i_band Fail Live S1 S2 Dst
+
+gc_bif2 Fail Live u$bif:erlang:bor/2 S1 S2 Dst => \
+ i_bor Fail Live S1 S2 Dst
-gc_bif1 Fail I u$bif:erlang:sminus/1 Src Dst=d => i_fetch i Src | i_minus Fail I Dst
-gc_bif1 Fail I u$bif:erlang:splus/1 Src Dst=d => i_fetch i Src | i_plus Fail I Dst
+gc_bif2 Fail Live u$bif:erlang:bxor/2 S1 S2 Dst => \
+ i_bxor Fail Live S1 S2 Dst
+
+gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst
i_increment r I I d
i_increment x I I d
i_increment y I I d
i_plus j I x x d
-i_plus j I d
+i_plus j I x y d
+i_plus j I s s d
+
i_minus j I x x d
-i_minus j I d
-i_times j I d
-i_m_div j I d
-i_int_div j I d
+i_minus j I s s d
+
+i_times j I s s d
+
+i_m_div j I s s d
+i_int_div j I s s d
+
i_rem j I x x d
-i_rem j I d
+i_rem j I s s d
-i_bsl j I d
-i_bsr j I d
+i_bsl j I s s d
+i_bsr j I s s d
i_band j I x c d
-i_band j I d
-i_bor j I d
-i_bxor j I d
+i_band j I s s d
+
+i_bor j I s s d
+i_bxor j I s s d
i_int_bnot j s I d
@@ -1731,21 +1623,18 @@ gc_bif2 Fail I Bif S1 S2 Dst => \
gc_bif3 Fail I Bif S1 S2 S3 Dst => \
gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst)
-i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D
-
i_gc_bif1 j I s I d
-ii_gc_bif2/6
-
-ii_gc_bif2 Fail Bif S1 S2 Live D => i_fetch S1 S2 | i_gc_bif2 Fail Bif Live D
-
-i_gc_bif2 j I I d
+i_gc_bif2 j I I s s d
ii_gc_bif3/7
-ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D
+# A specific instruction can only have 6 operands, so we must
+# pass one of the arguments in an x register.
+ii_gc_bif3 Fail Bif Live S1 S2 S3 Dst => \
+ move S1 x | i_gc_bif3 Fail Bif Live S2 S3 Dst
-i_gc_bif3 j I s I d
+i_gc_bif3 j I I s s d
#
# The following instruction is specially handled in beam_load.c
diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c
index 7ade8bca0f..fdb6cbc813 100644
--- a/erts/emulator/beam/register.c
+++ b/erts/emulator/beam/register.c
@@ -151,6 +151,9 @@ void init_register_table(void)
f.cmp = (HCMP_FUN) reg_cmp;
f.alloc = (HALLOC_FUN) reg_alloc;
f.free = (HFREE_FUN) reg_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_REG_TABLE, &process_reg, "process_reg",
PREG_HASH_SIZE, f);
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 03e30573de..068d636a40 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -21,6 +21,19 @@
#ifndef __SYS_H__
#define __SYS_H__
+#if !defined(__GNUC__)
+# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0
+#elif !defined(__GNUC_MINOR__)
+# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+ ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#elif !defined(__GNUC_PATCHLEVEL__)
+# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+ (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#else
+# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+ (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#endif
+
#ifdef ERTS_INLINE
# ifndef ERTS_CAN_INLINE
# define ERTS_CAN_INLINE 1
@@ -38,6 +51,17 @@
# endif
#endif
+#ifndef ERTS_FORCE_INLINE
+# if ERTS_AT_LEAST_GCC_VSN__(3,1,1)
+# define ERTS_FORCE_INLINE __inline__ __attribute__((__always_inline__))
+# elif defined(__WIN32__)
+# define ERTS_FORCE_INLINE __forceinline
+# endif
+# ifndef ERTS_FORCE_INLINE
+# define ERTS_FORCE_INLINE ERTS_INLINE
+# endif
+#endif
+
#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK)
# undef ERTS_CAN_INLINE
# define ERTS_CAN_INLINE 0
@@ -46,8 +70,10 @@
#endif
#if ERTS_CAN_INLINE
+#define ERTS_GLB_FORCE_INLINE static ERTS_FORCE_INLINE
#define ERTS_GLB_INLINE static ERTS_INLINE
#else
+#define ERTS_GLB_FORCE_INLINE
#define ERTS_GLB_INLINE
#endif
@@ -61,22 +87,14 @@
# define NO_FPE_SIGNALS
#endif
-#ifdef DISABLE_CHILD_WAITER_THREAD
-#undef ENABLE_CHILD_WAITER_THREAD
-#endif
-
-#if defined(ERTS_SMP) && !defined(DISABLE_CHILD_WAITER_THREAD)
-#undef ENABLE_CHILD_WAITER_THREAD
-#define ENABLE_CHILD_WAITER_THREAD 1
-#endif
-
#define ERTS_I64_LITERAL(X) X##LL
+#define ErtsInArea(ptr,start,nbytes) \
+ ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
+
#if defined (__WIN32__)
# include "erl_win_sys.h"
-#elif defined (__OSE__)
-# include "erl_ose_sys.h"
-#else
+#else
# include "erl_unix_sys.h"
#ifndef UNIX
# define UNIX 1
@@ -111,19 +129,6 @@ typedef int ErtsSysFdType;
typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
#endif
-#if !defined(__GNUC__)
-# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0
-#elif !defined(__GNUC_MINOR__)
-# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
- ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#elif !defined(__GNUC_PATCHLEVEL__)
-# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
- (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#else
-# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
- (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#endif
-
#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0)
# define ERTS_LIKELY(BOOL) __builtin_expect((BOOL), !0)
# define ERTS_UNLIKELY(BOOL) __builtin_expect((BOOL), 0)
@@ -131,6 +136,17 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
# define ERTS_LIKELY(BOOL) (BOOL)
# define ERTS_UNLIKELY(BOOL) (BOOL)
#endif
+
+#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0)
+#ifndef __llvm__
+# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("ERTS_LOW_WRITE") ))
+#else
+# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("__DATA,ERTS_LOW_WRITE") ))
+#endif
+#else
+# define ERTS_WRITE_UNLIKELY(X) X
+#endif
+
#ifdef __GNUC__
# if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5)
# define ERTS_DECLARE_DUMMY(X) X __attribute__ ((unused))
@@ -191,6 +207,12 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f
# define ASSERT(e) ((void) 1)
#endif
+#ifdef ERTS_SMP
+# define ERTS_SMP_ASSERT(e) ASSERT(e)
+#else
+# define ERTS_SMP_ASSERT(e) ((void)1)
+#endif
+
/* ERTS_UNDEF can be used to silence false warnings about
* "variable may be used uninitialized" while keeping the variable
* marked as undefined by valgrind.
@@ -285,62 +307,11 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f
#else
#error Neither 32 nor 64 bit architecture
#endif
-#if defined(ARCH_64) && defined(HALFWORD_HEAP_EMULATOR)
-# define HALFWORD_HEAP 1
-# define HALFWORD_ASSERT 0
-# define ASSERT_HALFWORD(COND) ASSERT(COND)
-# undef ERTS_SIZEOF_TERM
-# define ERTS_SIZEOF_TERM 4
-#else
-# define HALFWORD_HEAP 0
-# define HALFWORD_ASSERT 0
-# define ASSERT_HALFWORD(COND)
-#endif
#if SIZEOF_VOID_P != SIZEOF_SIZE_T
#error sizeof(void*) != sizeof(size_t)
#endif
-#if HALFWORD_HEAP
-
-#if SIZEOF_INT == 4
-typedef unsigned int Eterm;
-typedef unsigned int Uint;
-typedef int Sint;
-#define ERTS_UINT_MAX UINT_MAX
-#define ERTS_SIZEOF_ETERM SIZEOF_INT
-#define ErtsStrToSint strtol
-#else
-#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint'
-#endif
-
-#if SIZEOF_VOID_P == SIZEOF_LONG
-typedef unsigned long UWord;
-typedef long SWord;
-#define SWORD_CONSTANT(Const) Const##L
-#define UWORD_CONSTANT(Const) Const##UL
-#define ERTS_UWORD_MAX ULONG_MAX
-#define ERTS_SWORD_MAX LONG_MAX
-#elif SIZEOF_VOID_P == SIZEOF_INT
-typedef unsigned int UWord;
-typedef int SWord;
-#define SWORD_CONSTANT(Const) Const
-#define UWORD_CONSTANT(Const) Const##U
-#define ERTS_UWORD_MAX UINT_MAX
-#define ERTS_SWORD_MAX INT_MAX
-#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG
-typedef unsigned long long UWord;
-typedef long long SWord;
-#define SWORD_CONSTANT(Const) Const##LL
-#define UWORD_CONSTANT(Const) Const##ULL
-#define ERTS_UWORD_MAX ULLONG_MAX
-#define ERTS_SWORD_MAX LLONG_MAX
-#else
-#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint'
-#endif
-
-#else /* !HALFWORD_HEAP */
-
#if SIZEOF_VOID_P == SIZEOF_LONG
typedef unsigned long Eterm;
typedef unsigned long Uint;
@@ -383,8 +354,6 @@ typedef Uint UWord;
typedef Sint SWord;
#define ERTS_UINT_MAX ERTS_UWORD_MAX
-#endif /* HALFWORD_HEAP */
-
typedef UWord BeamInstr;
#ifndef HAVE_INT64
@@ -785,6 +754,7 @@ void erts_sys_main_thread(void);
extern int erts_sys_prepare_crash_dump(int secs);
extern void erts_sys_pre_init(void);
extern void erl_sys_init(void);
+extern void erl_sys_late_init(void);
extern void erl_sys_args(int *argc, char **argv);
extern void erl_sys_schedule(int);
void sys_tty_reset(int);
@@ -1102,7 +1072,6 @@ extern int erts_use_kernel_poll;
#define put_int8(i, s) do {((unsigned char*)(s))[0] = (i) & 0xff;} while (0)
-
/*
* Use DEBUGF as you would use printf, but use double parentheses:
*
diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c
index 0ab6661c9f..48cb39333a 100644
--- a/erts/emulator/beam/time.c
+++ b/erts/emulator/beam/time.c
@@ -278,9 +278,14 @@ ErtsMonotonicTime
erts_check_next_timeout_time(ErtsSchedulerData *esdp)
{
ErtsTimerWheel *tiw = esdp->timer_wheel;
+ ErtsMonotonicTime time;
+ ERTS_MSACC_DECLARE_CACHE_X();
if (tiw->true_next_timeout_time)
return tiw->next_timeout_time;
- return find_next_timeout(esdp, tiw, 1, 0, 0);
+ ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(ERTS_MSACC_STATE_TIMERS);
+ time = find_next_timeout(esdp, tiw, 1, 0, 0);
+ ERTS_MSACC_POP_STATE_M_X();
+ return time;
}
#ifndef ERTS_TW_DEBUG
@@ -336,6 +341,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
{
int tiw_pos_ix, slots, yielded_slot_restarted, yield_count;
ErtsMonotonicTime bump_to, tmp_slots, old_pos;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS);
yield_count = ERTS_TWHEEL_BUMP_YIELD_LIMIT;
@@ -371,6 +377,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
tiw->next_timeout_time = curr_time + ERTS_MONOTONIC_DAY;
tiw->pos = bump_to;
tiw->yield_slot = ERTS_TWHEEL_SLOT_INACTIVE;
+ ERTS_MSACC_POP_STATE_M_X();
return;
}
@@ -382,6 +389,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
tiw->yield_slot = ERTS_TWHEEL_SLOT_AT_ONCE;
tiw->true_next_timeout_time = 1;
tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(old_pos);
+ ERTS_MSACC_POP_STATE_M_X();
return;
}
@@ -400,8 +408,10 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
p = tiw->at_once.head;
}
- if (tiw->pos >= bump_to)
+ if (tiw->pos >= bump_to) {
+ ERTS_MSACC_POP_STATE_M_X();
break;
+ }
if (tiw->nto == 0)
goto empty_wheel;
@@ -478,6 +488,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
tiw->yield_slot = tiw_pos_ix;
tiw->yield_slots_left = slots;
tiw->yield_start_pos = old_pos;
+ ERTS_MSACC_POP_STATE_M_X();
return; /* Yield! */
}
@@ -500,6 +511,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
/* Search at most two seconds ahead... */
(void) find_next_timeout(NULL, tiw, 0, curr_time, ERTS_SEC_TO_MONOTONIC(2));
+ ERTS_MSACC_POP_STATE_M_X();
}
Uint
@@ -569,6 +581,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw,
ErtsMonotonicTime timeout_pos)
{
ErtsMonotonicTime timeout_time;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS);
p->u.func.timeout = timeout;
p->u.func.cancel = cancel;
@@ -612,6 +625,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw,
tiw->true_next_timeout_time = 1;
tiw->next_timeout_time = timeout_time;
}
+ ERTS_MSACC_POP_STATE_M_X();
}
void
@@ -620,11 +634,13 @@ erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p)
if (p->slot != ERTS_TWHEEL_SLOT_INACTIVE) {
ErlCancelProc cancel;
void *arg;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS);
remove_timer(tiw, p);
cancel = p->u.func.cancel;
arg = p->u.func.arg;
if (cancel)
(*cancel)(arg);
+ ERTS_MSACC_POP_STATE_M_X();
}
}
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 5286391746..3ba02023a1 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -110,7 +110,6 @@ Eterm*
erts_heap_alloc(Process* p, Uint need, Uint xtra)
{
ErlHeapFragment* bp;
- Eterm* htop;
Uint n;
#if defined(DEBUG) || defined(CHECK_FOR_HOLES)
Uint i;
@@ -156,16 +155,6 @@ erts_heap_alloc(Process* p, Uint need, Uint xtra)
n--;
#endif
- /*
- * When we have created a heap fragment, we are no longer allowed
- * to store anything more on the heap.
- */
- htop = HEAP_TOP(p);
- if (htop < HEAP_LIMIT(p)) {
- *htop = make_pos_bignum_header(HEAP_LIMIT(p)-htop-1);
- HEAP_TOP(p) = HEAP_LIMIT(p);
- }
-
bp->next = MBUF(p);
MBUF(p) = bp;
bp->alloc_size = n;
@@ -269,6 +258,31 @@ erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes)
s->psp = s->pstart + sp_offs;
}
+/*
+ * Helper function for the EQUEUE macros defined in global.h.
+ */
+
+void
+erl_grow_equeue(ErtsEQueue* q, Eterm* default_equeue)
+{
+ Uint old_size = (q->end - q->start);
+ Uint new_size = old_size * 2;
+ Uint first_part = (q->end - q->front);
+ Uint second_part = (q->back - q->start);
+ Eterm* new_ptr = erts_alloc(q->alloc_type, new_size*sizeof(Eterm));
+ ASSERT(q->back == q->front); // of course the queue is full now!
+ if (first_part > 0)
+ sys_memcpy(new_ptr, q->front, first_part*sizeof(Eterm));
+ if (second_part > 0)
+ sys_memcpy(new_ptr+first_part, q->start, second_part*sizeof(Eterm));
+ if (q->start != default_equeue)
+ erts_free(q->alloc_type, q->start);
+ q->start = new_ptr;
+ q->end = q->start + new_size;
+ q->front = q->start;
+ q->back = q->start + old_size;
+}
+
/* CTYPE macros */
#define LATIN1
@@ -303,10 +317,10 @@ erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes)
* Calculate length of a list.
* Returns -1 if not a proper list (i.e. not terminated with NIL)
*/
-int
+Sint
erts_list_length(Eterm list)
{
- int i = 0;
+ Sint i = 0;
while(is_list(list)) {
i++;
@@ -894,7 +908,7 @@ tail_recur:
Uint y2 = y1 < 0 ? -(Uint)y1 : y1;
UINT32_HASH_STEP(y2, FUNNY_NUMBER2);
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (y2 >> 32)
UINT32_HASH_STEP(y2 >> 32, FUNNY_NUMBER2);
#endif
@@ -1015,7 +1029,7 @@ tail_recur:
}
d = BIG_DIGIT(ptr, k);
k = sizeof(ErtsDigit);
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (!(d >> 32))
k /= 2;
#endif
@@ -1985,7 +1999,7 @@ tail_recur:
(atom_tab(atom_val(term))->slot.bucket.hvalue);
break;
case SMALL_DEF:
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
{
Sint y1 = signed_val(term);
Uint y2 = y1 < 0 ? -(Uint)y1 : y1;
@@ -2281,7 +2295,11 @@ static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment *
erts_queue_error_logger_message(from, message, bp);
}
#else
- erts_queue_message(p, NULL /* only used for smp build */, bp, message, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(p, NULL /* only used for smp build */, mp, message, NIL);
+ }
#endif
}
@@ -2594,11 +2612,7 @@ erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp)
* Test for equality of two terms.
* Returns 0 if not equal, or a non-zero value otherwise.
*/
-#if HALFWORD_HEAP
-int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base)
-#else
int eq(Eterm a, Eterm b)
-#endif
{
DECLARE_WSTACK(stack);
Sint sz;
@@ -2606,18 +2620,18 @@ int eq(Eterm a, Eterm b)
Eterm* bb;
tailrecur:
- if (is_same(a, a_base, b, b_base)) goto pop_next;
+ if (is_same(a, b)) goto pop_next;
tailrecur_ne:
switch (primary_tag(a)) {
case TAG_PRIMARY_LIST:
if (is_list(b)) {
- Eterm* aval = list_val_rel(a, a_base);
- Eterm* bval = list_val_rel(b, b_base);
+ Eterm* aval = list_val(a);
+ Eterm* bval = list_val(b);
while (1) {
Eterm atmp = CAR(aval);
Eterm btmp = CAR(bval);
- if (!is_same(atmp,a_base,btmp,b_base)) {
+ if (!is_same(atmp,btmp)) {
WSTACK_PUSH2(stack,(UWord) CDR(bval),(UWord) CDR(aval));
a = atmp;
b = btmp;
@@ -2625,7 +2639,7 @@ tailrecur_ne:
}
atmp = CDR(aval);
btmp = CDR(bval);
- if (is_same(atmp,a_base,btmp,b_base)) {
+ if (is_same(atmp,btmp)) {
goto pop_next;
}
if (is_not_list(atmp) || is_not_list(btmp)) {
@@ -2633,22 +2647,22 @@ tailrecur_ne:
b = btmp;
goto tailrecur_ne;
}
- aval = list_val_rel(atmp, a_base);
- bval = list_val_rel(btmp, b_base);
+ aval = list_val(atmp);
+ bval = list_val(btmp);
}
}
break; /* not equal */
case TAG_PRIMARY_BOXED:
{
- Eterm hdr = *boxed_val_rel(a,a_base);
+ Eterm hdr = *boxed_val(a);
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
{
- aa = tuple_val_rel(a, a_base);
- if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa)
+ aa = tuple_val(a);
+ if (!is_boxed(b) || *boxed_val(b) != *aa)
goto not_equal;
- bb = tuple_val_rel(b,b_base);
+ bb = tuple_val(b);
if ((sz = arityval(*aa)) == 0) goto pop_next;
++aa;
++bb;
@@ -2667,16 +2681,16 @@ tailrecur_ne:
Uint a_bitoffs;
Uint b_bitoffs;
- if (!is_binary_rel(b,b_base)) {
+ if (!is_binary(b)) {
goto not_equal;
}
- a_size = binary_size_rel(a,a_base);
- b_size = binary_size_rel(b,b_base);
+ a_size = binary_size(a);
+ b_size = binary_size(b);
if (a_size != b_size) {
goto not_equal;
}
- ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base);
- ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base);
+ ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize);
+ ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize);
if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) {
if (sys_memcmp(a_ptr, b_ptr, a_size) == 0) goto pop_next;
} else if (a_bitsize == b_bitsize) {
@@ -2687,9 +2701,9 @@ tailrecur_ne:
}
case EXPORT_SUBTAG:
{
- if (is_export_rel(b,b_base)) {
- Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1));
- Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1));
+ if (is_export(b)) {
+ Export* a_exp = *((Export **) (export_val(a) + 1));
+ Export* b_exp = *((Export **) (export_val(b) + 1));
if (a_exp == b_exp) goto pop_next;
}
break; /* not equal */
@@ -2699,10 +2713,10 @@ tailrecur_ne:
ErlFunThing* f1;
ErlFunThing* f2;
- if (!is_fun_rel(b,b_base))
+ if (!is_fun(b))
goto not_equal;
- f1 = (ErlFunThing *) fun_val_rel(a,a_base);
- f2 = (ErlFunThing *) fun_val_rel(b,b_base);
+ f1 = (ErlFunThing *) fun_val(a);
+ f2 = (ErlFunThing *) fun_val(b);
if (f1->fe->module != f2->fe->module ||
f1->fe->old_index != f2->fe->old_index ||
f1->fe->old_uniq != f2->fe->old_uniq ||
@@ -2720,15 +2734,15 @@ tailrecur_ne:
ExternalThing *ap;
ExternalThing *bp;
- if(!is_external_rel(b,b_base))
+ if(!is_external(b))
goto not_equal;
- ap = external_thing_ptr_rel(a,a_base);
- bp = external_thing_ptr_rel(b,b_base);
+ ap = external_thing_ptr(a);
+ bp = external_thing_ptr(b);
if(ap->header == bp->header && ap->node == bp->node) {
- ASSERT(1 == external_data_words_rel(a,a_base));
- ASSERT(1 == external_data_words_rel(b,b_base));
+ ASSERT(1 == external_data_words(a));
+ ASSERT(1 == external_data_words(b));
if (ap->data.ui[0] == bp->data.ui[0]) goto pop_next;
}
@@ -2749,11 +2763,11 @@ tailrecur_ne:
ExternalThing* athing;
ExternalThing* bthing;
- if(!is_external_ref_rel(b,b_base))
+ if(!is_external_ref(b))
goto not_equal;
- athing = external_thing_ptr_rel(a,a_base);
- bthing = external_thing_ptr_rel(b,b_base);
+ athing = external_thing_ptr(a);
+ bthing = external_thing_ptr(b);
if(athing->node != bthing->node)
goto not_equal;
@@ -2765,12 +2779,12 @@ tailrecur_ne:
goto ref_common;
case REF_SUBTAG:
- if (!is_internal_ref_rel(b,b_base))
+ if (!is_internal_ref(b))
goto not_equal;
{
- RefThing* athing = ref_thing_ptr_rel(a,a_base);
- RefThing* bthing = ref_thing_ptr_rel(b,b_base);
+ RefThing* athing = ref_thing_ptr(a);
+ RefThing* bthing = ref_thing_ptr(b);
alen = internal_thing_ref_no_of_numbers(athing);
blen = internal_thing_ref_no_of_numbers(bthing);
anum = internal_thing_ref_numbers(athing);
@@ -2820,10 +2834,10 @@ tailrecur_ne:
{
int i;
- if (!is_big_rel(b,b_base))
+ if (!is_big(b))
goto not_equal;
- aa = big_val_rel(a,a_base);
- bb = big_val_rel(b,b_base);
+ aa = big_val(a);
+ bb = big_val(b);
if (*aa != *bb)
goto not_equal;
i = BIG_ARITY(aa);
@@ -2838,19 +2852,19 @@ tailrecur_ne:
FloatDef af;
FloatDef bf;
- if (is_float_rel(b,b_base)) {
- GET_DOUBLE_REL(a, af, a_base);
- GET_DOUBLE_REL(b, bf, b_base);
+ if (is_float(b)) {
+ GET_DOUBLE(a, af);
+ GET_DOUBLE(b, bf);
if (af.fd == bf.fd) goto pop_next;
}
break; /* not equal */
}
case MAP_SUBTAG:
- if (is_flatmap_rel(a, a_base)) {
- aa = flatmap_val_rel(a, a_base);
- if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa)
+ if (is_flatmap(a)) {
+ aa = flatmap_val(a);
+ if (!is_boxed(b) || *boxed_val(b) != *aa)
goto not_equal;
- bb = flatmap_val_rel(b,b_base);
+ bb = flatmap_val(b);
sz = flatmap_get_size((flatmap_t*)aa);
if (sz != flatmap_get_size((flatmap_t*)bb)) goto not_equal;
@@ -2862,11 +2876,11 @@ tailrecur_ne:
goto term_array;
} else {
- if (!is_boxed(b) || *boxed_val_rel(b,b_base) != hdr)
+ if (!is_boxed(b) || *boxed_val(b) != hdr)
goto not_equal;
- aa = hashmap_val_rel(a, a_base) + 1;
- bb = hashmap_val_rel(b, b_base) + 1;
+ aa = hashmap_val(a) + 1;
+ bb = hashmap_val(b) + 1;
switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
case HAMT_SUBTAG_HEAD_ARRAY:
aa++; bb++;
@@ -2899,7 +2913,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'sz' */
Eterm* bp = bb;
Sint i = sz;
for (;;) {
- if (!is_same(*ap,a_base,*bp,b_base)) break;
+ if (!is_same(*ap,*bp)) break;
if (--i == 0) goto pop_next;
++ap;
++bp;
@@ -2977,7 +2991,7 @@ static int cmpbytes(byte *s1, int l1, byte *s2, int l2)
#define float_comp(x,y) (((x)<(y)) ? -1 : (((x)==(y)) ? 0 : 1))
-static int cmp_atoms(Eterm a, Eterm b)
+int erts_cmp_atoms(Eterm a, Eterm b)
{
Atom *aa = atom_tab(atom_val(a));
Atom *bb = atom_tab(atom_val(b));
@@ -2988,7 +3002,6 @@ static int cmp_atoms(Eterm a, Eterm b)
bb->name+3, bb->len-3);
}
-#if !HALFWORD_HEAP
/* cmp(Eterm a, Eterm b)
* For compatibility with HiPE - arith-based compare.
*/
@@ -2996,39 +3009,22 @@ Sint cmp(Eterm a, Eterm b)
{
return erts_cmp(a, b, 0, 0);
}
-#endif
-#if HALFWORD_HEAP
-static Sint erts_cmp_compound_rel_opt(Eterm a, Eterm* a_base,
- Eterm b, Eterm* b_base,
- int exact, int eq_only);
-#else
-static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only);
-#endif
+Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only);
-#if HALFWORD_HEAP
-Sint erts_cmp_rel_opt(Eterm a, Eterm* a_base,
- Eterm b, Eterm* b_base,
- int exact, int eq_only)
-#else
Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only)
-#endif
{
if (is_atom(a) && is_atom(b)) {
- return cmp_atoms(a, b);
+ return erts_cmp_atoms(a, b);
} else if (is_both_small(a, b)) {
return (signed_val(a) - signed_val(b));
- } else if (is_float_rel(a, a_base) && is_float_rel(b, b_base)) {
+ } else if (is_float(a) && is_float(b)) {
FloatDef af, bf;
- GET_DOUBLE_REL(a, af, a_base);
- GET_DOUBLE_REL(b, bf, b_base);
+ GET_DOUBLE(a, af);
+ GET_DOUBLE(b, bf);
return float_comp(af.fd, bf.fd);
}
-#if HALFWORD_HEAP
- return erts_cmp_compound_rel_opt(a,a_base,b,b_base,exact,eq_only);
-#else
return erts_cmp_compound(a,b,exact,eq_only);
-#endif
}
@@ -3036,13 +3032,7 @@ Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only)
* exact = 1 -> term-based compare
* exact = 0 -> arith-based compare
*/
-#if HALFWORD_HEAP
-static Sint erts_cmp_compound_rel_opt(Eterm a, Eterm* a_base,
- Eterm b, Eterm* b_base,
- int exact, int eq_only)
-#else
-static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
-#endif
+Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
{
#define PSTACK_TYPE struct erts_cmp_hashmap_state
struct erts_cmp_hashmap_state {
@@ -3099,7 +3089,7 @@ static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
do { \
if((AN) != (BN)) { \
if((AN)->sysname != (BN)->sysname) \
- RETURN_NEQ(cmp_atoms((AN)->sysname, (BN)->sysname)); \
+ RETURN_NEQ(erts_cmp_atoms((AN)->sysname, (BN)->sysname)); \
ASSERT((AN)->creation != (BN)->creation); \
RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \
} \
@@ -3109,7 +3099,7 @@ static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
bodyrecur:
j = 0;
tailrecur:
- if (is_same(a,a_base,b,b_base)) { /* Equal values or pointers. */
+ if (is_same(a,b)) { /* Equal values or pointers. */
goto pop_next;
}
tailrecur_ne:
@@ -3117,7 +3107,7 @@ tailrecur_ne:
/* deal with majority (?) cases by brute-force */
if (is_atom(a)) {
if (is_atom(b)) {
- ON_CMP_GOTO(cmp_atoms(a, b));
+ ON_CMP_GOTO(erts_cmp_atoms(a, b));
}
} else if (is_both_small(a, b)) {
ON_CMP_GOTO(signed_val(a) - signed_val(b));
@@ -3135,9 +3125,9 @@ tailrecur_ne:
if (is_internal_port(b)) {
bnode = erts_this_node;
bdata = internal_port_data(b);
- } else if (is_external_port_rel(b,b_base)) {
- bnode = external_port_node_rel(b,b_base);
- bdata = external_port_data_rel(b,b_base);
+ } else if (is_external_port(b)) {
+ bnode = external_port_node(b);
+ bdata = external_port_data(b);
} else {
a_tag = PORT_DEF;
goto mixed_types;
@@ -3153,9 +3143,9 @@ tailrecur_ne:
if (is_internal_pid(b)) {
bnode = erts_this_node;
bdata = internal_pid_data(b);
- } else if (is_external_pid_rel(b,b_base)) {
- bnode = external_pid_node_rel(b,b_base);
- bdata = external_pid_data_rel(b,b_base);
+ } else if (is_external_pid(b)) {
+ bnode = external_pid_node(b);
+ bdata = external_pid_data(b);
} else {
a_tag = PID_DEF;
goto mixed_types;
@@ -3188,12 +3178,12 @@ tailrecur_ne:
a_tag = LIST_DEF;
goto mixed_types;
}
- aa = list_val_rel(a,a_base);
- bb = list_val_rel(b,b_base);
+ aa = list_val(a);
+ bb = list_val(b);
while (1) {
Eterm atmp = CAR(aa);
Eterm btmp = CAR(bb);
- if (!is_same(atmp,a_base,btmp,b_base)) {
+ if (!is_same(atmp,btmp)) {
WSTACK_PUSH2(stack,(UWord) CDR(bb),(UWord) CDR(aa));
a = atmp;
b = btmp;
@@ -3201,7 +3191,7 @@ tailrecur_ne:
}
atmp = CDR(aa);
btmp = CDR(bb);
- if (is_same(atmp,a_base,btmp,b_base)) {
+ if (is_same(atmp,btmp)) {
goto pop_next;
}
if (is_not_list(atmp) || is_not_list(btmp)) {
@@ -3209,20 +3199,20 @@ tailrecur_ne:
b = btmp;
goto tailrecur_ne;
}
- aa = list_val_rel(atmp,a_base);
- bb = list_val_rel(btmp,b_base);
+ aa = list_val(atmp);
+ bb = list_val(btmp);
}
case TAG_PRIMARY_BOXED:
{
- Eterm ahdr = *boxed_val_rel(a,a_base);
+ Eterm ahdr = *boxed_val(a);
switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE):
- if (!is_tuple_rel(b,b_base)) {
+ if (!is_tuple(b)) {
a_tag = TUPLE_DEF;
goto mixed_types;
}
- aa = tuple_val_rel(a,a_base);
- bb = tuple_val_rel(b,b_base);
+ aa = tuple_val(a);
+ bb = tuple_val(b);
/* compare the arities */
i = arityval(ahdr); /* get the arity*/
if (i != arityval(*bb)) {
@@ -3238,18 +3228,18 @@ tailrecur_ne:
{
struct erts_cmp_hashmap_state* sp;
if (is_flatmap_header(ahdr)) {
- if (!is_flatmap_rel(b,b_base)) {
- if (is_hashmap_rel(b,b_base)) {
- aa = (Eterm *)flatmap_val_rel(a,a_base);
- i = flatmap_get_size((flatmap_t*)aa) - hashmap_size_rel(b,b_base);
+ if (!is_flatmap(b)) {
+ if (is_hashmap(b)) {
+ aa = (Eterm *)flatmap_val(a);
+ i = flatmap_get_size((flatmap_t*)aa) - hashmap_size(b);
ASSERT(i != 0);
RETURN_NEQ(i);
}
a_tag = MAP_DEF;
goto mixed_types;
}
- aa = (Eterm *)flatmap_val_rel(a,a_base);
- bb = (Eterm *)flatmap_val_rel(b,b_base);
+ aa = (Eterm *)flatmap_val(a);
+ bb = (Eterm *)flatmap_val(b);
i = flatmap_get_size((flatmap_t*)aa);
if (i != flatmap_get_size((flatmap_t*)bb)) {
@@ -3276,21 +3266,21 @@ tailrecur_ne:
goto bodyrecur;
}
}
- if (!is_hashmap_rel(b,b_base)) {
- if (is_flatmap_rel(b,b_base)) {
- bb = (Eterm *)flatmap_val_rel(b,b_base);
- i = hashmap_size_rel(a,a_base) - flatmap_get_size((flatmap_t*)bb);
+ if (!is_hashmap(b)) {
+ if (is_flatmap(b)) {
+ bb = (Eterm *)flatmap_val(b);
+ i = hashmap_size(a) - flatmap_get_size((flatmap_t*)bb);
ASSERT(i != 0);
RETURN_NEQ(i);
}
a_tag = MAP_DEF;
goto mixed_types;
}
- i = hashmap_size_rel(a,a_base) - hashmap_size_rel(b,b_base);
+ i = hashmap_size(a) - hashmap_size(b);
if (i) {
RETURN_NEQ(i);
}
- if (hashmap_size_rel(a,a_base) == 0) {
+ if (hashmap_size(a) == 0) {
goto pop_next;
}
@@ -3325,48 +3315,48 @@ tailrecur_ne:
goto bodyrecur;
}
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- if (!is_float_rel(b,b_base)) {
+ if (!is_float(b)) {
a_tag = FLOAT_DEF;
goto mixed_types;
} else {
FloatDef af;
FloatDef bf;
- GET_DOUBLE_REL(a, af, a_base);
- GET_DOUBLE_REL(b, bf, b_base);
+ GET_DOUBLE(a, af);
+ GET_DOUBLE(b, bf);
ON_CMP_GOTO(float_comp(af.fd, bf.fd));
}
case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- if (!is_big_rel(b,b_base)) {
+ if (!is_big(b)) {
a_tag = BIG_DEF;
goto mixed_types;
}
- ON_CMP_GOTO(big_comp(rterm2wterm(a,a_base), rterm2wterm(b,b_base)));
+ ON_CMP_GOTO(big_comp(a, b));
case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE):
- if (!is_export_rel(b,b_base)) {
+ if (!is_export(b)) {
a_tag = EXPORT_DEF;
goto mixed_types;
} else {
- Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1));
- Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1));
+ Export* a_exp = *((Export **) (export_val(a) + 1));
+ Export* b_exp = *((Export **) (export_val(b) + 1));
- if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) {
+ if ((j = erts_cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) {
RETURN_NEQ(j);
}
- if ((j = cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) {
+ if ((j = erts_cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) {
RETURN_NEQ(j);
}
ON_CMP_GOTO((Sint) a_exp->code[2] - (Sint) b_exp->code[2]);
}
break;
case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE):
- if (!is_fun_rel(b,b_base)) {
+ if (!is_fun(b)) {
a_tag = FUN_DEF;
goto mixed_types;
} else {
- ErlFunThing* f1 = (ErlFunThing *) fun_val_rel(a,a_base);
- ErlFunThing* f2 = (ErlFunThing *) fun_val_rel(b,b_base);
+ ErlFunThing* f1 = (ErlFunThing *) fun_val(a);
+ ErlFunThing* f2 = (ErlFunThing *) fun_val(b);
Sint diff;
diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name,
@@ -3398,29 +3388,29 @@ tailrecur_ne:
if (is_internal_pid(b)) {
bnode = erts_this_node;
bdata = internal_pid_data(b);
- } else if (is_external_pid_rel(b,b_base)) {
- bnode = external_pid_node_rel(b,b_base);
- bdata = external_pid_data_rel(b,b_base);
+ } else if (is_external_pid(b)) {
+ bnode = external_pid_node(b);
+ bdata = external_pid_data(b);
} else {
a_tag = EXTERNAL_PID_DEF;
goto mixed_types;
}
- anode = external_pid_node_rel(a,a_base);
- adata = external_pid_data_rel(a,a_base);
+ anode = external_pid_node(a);
+ adata = external_pid_data(a);
goto pid_common;
case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE):
if (is_internal_port(b)) {
bnode = erts_this_node;
bdata = internal_port_data(b);
- } else if (is_external_port_rel(b,b_base)) {
- bnode = external_port_node_rel(b,b_base);
- bdata = external_port_data_rel(b,b_base);
+ } else if (is_external_port(b)) {
+ bnode = external_port_node(b);
+ bdata = external_port_data(b);
} else {
a_tag = EXTERNAL_PORT_DEF;
goto mixed_types;
}
- anode = external_port_node_rel(a,a_base);
- adata = external_port_data_rel(a,a_base);
+ anode = external_port_node(a);
+ adata = external_port_data(a);
goto port_common;
case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE):
/*
@@ -3428,14 +3418,13 @@ tailrecur_ne:
* (32-bit words), *not* ref data words.
*/
-
- if (is_internal_ref_rel(b,b_base)) {
- RefThing* bthing = ref_thing_ptr_rel(b,b_base);
+ if (is_internal_ref(b)) {
+ RefThing* bthing = ref_thing_ptr(b);
bnode = erts_this_node;
bnum = internal_thing_ref_numbers(bthing);
blen = internal_thing_ref_no_of_numbers(bthing);
- } else if(is_external_ref_rel(b,b_base)) {
- ExternalThing* bthing = external_thing_ptr_rel(b,b_base);
+ } else if(is_external_ref(b)) {
+ ExternalThing* bthing = external_thing_ptr(b);
bnode = bthing->node;
bnum = external_thing_ref_numbers(bthing);
blen = external_thing_ref_no_of_numbers(bthing);
@@ -3444,7 +3433,7 @@ tailrecur_ne:
goto mixed_types;
}
{
- RefThing* athing = ref_thing_ptr_rel(a,a_base);
+ RefThing* athing = ref_thing_ptr(a);
anode = erts_this_node;
anum = internal_thing_ref_numbers(athing);
alen = internal_thing_ref_no_of_numbers(athing);
@@ -3477,13 +3466,13 @@ tailrecur_ne:
RETURN_NEQ((Sint32) (anum[i] - bnum[i]));
goto pop_next;
case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE):
- if (is_internal_ref_rel(b,b_base)) {
- RefThing* bthing = ref_thing_ptr_rel(b,b_base);
+ if (is_internal_ref(b)) {
+ RefThing* bthing = ref_thing_ptr(b);
bnode = erts_this_node;
bnum = internal_thing_ref_numbers(bthing);
blen = internal_thing_ref_no_of_numbers(bthing);
- } else if (is_external_ref_rel(b,b_base)) {
- ExternalThing* bthing = external_thing_ptr_rel(b,b_base);
+ } else if (is_external_ref(b)) {
+ ExternalThing* bthing = external_thing_ptr(b);
bnode = bthing->node;
bnum = external_thing_ref_numbers(bthing);
blen = external_thing_ref_no_of_numbers(bthing);
@@ -3492,7 +3481,7 @@ tailrecur_ne:
goto mixed_types;
}
{
- ExternalThing* athing = external_thing_ptr_rel(a,a_base);
+ ExternalThing* athing = external_thing_ptr(a);
anode = athing->node;
anum = external_thing_ref_numbers(athing);
alen = external_thing_ref_no_of_numbers(athing);
@@ -3500,13 +3489,13 @@ tailrecur_ne:
goto ref_common;
default:
/* Must be a binary */
- ASSERT(is_binary_rel(a,a_base));
- if (!is_binary_rel(b,b_base)) {
+ ASSERT(is_binary(a));
+ if (!is_binary(b)) {
a_tag = BINARY_DEF;
goto mixed_types;
} else {
- Uint a_size = binary_size_rel(a,a_base);
- Uint b_size = binary_size_rel(b,b_base);
+ Uint a_size = binary_size(a);
+ Uint b_size = binary_size(b);
Uint a_bitsize;
Uint b_bitsize;
Uint a_bitoffs;
@@ -3515,8 +3504,8 @@ tailrecur_ne:
int cmp;
byte* a_ptr;
byte* b_ptr;
- ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base);
- ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base);
+ ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize);
+ ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize);
if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) {
min_size = (a_size < b_size) ? a_size : b_size;
if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) {
@@ -3547,13 +3536,8 @@ tailrecur_ne:
{
FloatDef f1, f2;
Eterm big;
-#if HALFWORD_HEAP
- Wterm aw = is_immed(a) ? a : rterm2wterm(a,a_base);
- Wterm bw = is_immed(b) ? b : rterm2wterm(b,b_base);
-#else
Eterm aw = a;
Eterm bw = b;
-#endif
#define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2))
#define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1))
#define BIG_ARITY_FLOAT_MAX (1024 / D_EXP) /* arity of max float as a bignum */
@@ -3625,7 +3609,7 @@ tailrecur_ne:
}
} else {
big = double_to_big(f2.fd, big_buf, sizeof(big_buf)/sizeof(Eterm));
- j = big_comp(aw, rterm2wterm(big,big_buf));
+ j = big_comp(aw, big);
}
if (_NUMBER_CODE(a_tag, b_tag) == FLOAT_BIG) {
j = -j;
@@ -3673,9 +3657,9 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */
while (--i) {
a = *aa++;
b = *bb++;
- if (!is_same(a,a_base, b,b_base)) {
+ if (!is_same(a, b)) {
if (is_atom(a) && is_atom(b)) {
- if ((j = cmp_atoms(a, b)) != 0) {
+ if ((j = erts_cmp_atoms(a, b)) != 0) {
goto not_equal;
}
} else if (is_both_small(a, b)) {
@@ -3946,11 +3930,11 @@ void bin_write(int to, void *to_arg, byte* buf, size_t sz)
/* Fill buf with the contents of bytelist list
return number of chars in list or -1 for error */
-int
-intlist_to_buf(Eterm list, char *buf, int len)
+Sint
+intlist_to_buf(Eterm list, char *buf, Sint len)
{
Eterm* listptr;
- int sz = 0;
+ Sint sz = 0;
if (is_nil(list))
return 0;
@@ -4365,7 +4349,7 @@ iolist_size(const int yield_support, ErtsIOListState *state, Eterm obj, ErlDrvSi
{
int res, init_yield_count, yield_count;
Eterm* objp;
- Uint size = (Uint) *sizep; /* Intentionally Uint due to halfword heap */
+ Uint size = (Uint) *sizep;
DECLARE_ESTACK(s);
if (!yield_support)
@@ -4497,11 +4481,12 @@ int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
return iolist_size(0, NULL, obj, sizep);
}
-/* return 0 if item is not a non-empty flat list of bytes */
-int
+/* return 0 if item is not a non-empty flat list of bytes
+ otherwise return the nonzero length of the list */
+Sint
is_string(Eterm list)
{
- int len = 0;
+ Sint len = 0;
while(is_list(list)) {
Eterm* consp = list_val(list);
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index a5a5dfb7f8..c5c780dce5 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -101,15 +101,9 @@
# include "config.h"
#endif
-#ifndef __OSE__
#include <ctype.h>
#include <sys/types.h>
#include <stdlib.h>
-#else
-#include "ctype.h"
-#include "sys/types.h"
-#include "stdlib.h"
-#endif
/* Need (NON)BLOCKING macros for sendfile */
#ifndef WANT_NONBLOCKING
@@ -895,7 +889,7 @@ static void reply_Uint_posix_error(file_descriptor *desc, Uint num,
TRACE_C('N');
response[0] = FILE_RESP_NUMERR;
-#if SIZEOF_VOID_P == 4 || HALFWORD_HEAP
+#if SIZEOF_VOID_P == 4
put_int32(0, response+1);
#else
put_int32(num>>32, response+1);
@@ -964,7 +958,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);
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index 43cb15a25f..f910b5955a 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -94,10 +94,6 @@ typedef unsigned long long llu_t;
#define INT16_MAX (32767)
#endif
-#ifdef __OSE__
-#include "inet.h"
-#endif
-
#ifdef __WIN32__
#define STRNCASECMP strncasecmp
@@ -298,139 +294,7 @@ static unsigned long one_value = 1;
#define TCP_SHUT_RD SD_RECEIVE
#define TCP_SHUT_RDWR SD_BOTH
-#elif defined (__OSE__)
-
-/*
- * Some notes about how inet (currently only tcp) works on OSE.
- * The driver uses OSE signals to communicate with the one_inet
- * process. Because of the difference in how signals and file descriptors
- * work the whole select/deselect mechanic is very different.
- * In ose when a sock_select is done a function is called. That function
- * notes the changes that the driver want to do, but does not act on it.
- * later when the function returns the new desired state is compared
- * to the previous state and the apprioriate actions are taken. The action
- * is usually to either request more data from the stack or stop requesting
- * data.
- *
- * One thing to note is that the driver never does select/deselect. It always
- * listens for the signals. Flow of data is regulated by sending or not sending
- * signals to the ose inet process.
- *
- * The interesting functions to look at are:
- * * inet_driver_select : called when sock_select is called
- * * tcp_inet_ose_dispatch_signal : checks state changes and sends new signals
- * * tcp_inet_drv_output_ose : ready output callback, reads signals and calls
- * dispatch_signal
- * * tcp_inet_drv_input_ose : ready input callback.
- */
-
-#include "efs.h"
-#include "sys/socket.h"
-#include "sys/uio.h"
-#include "sfk/sys/sfk_uio.h"
-#include "netinet/in.h"
-#include "netinet/tcp.h"
-#include "netdb.h"
-#include "ose_spi/socket.sig"
-
-
-static ssize_t writev_fallback(int fd, const struct iovec *iov, int iovcnt, int max_sz);
-
-#define INVALID_SOCKET -1
-#define INVALID_EVENT -1
-#define SOCKET_ERROR -1
-
-#define SOCKET int
-#define HANDLE int
-#define FD_READ ERL_DRV_READ
-#define FD_WRITE ERL_DRV_WRITE
-#define FD_CLOSE 0
-#define FD_CONNECT (1<<4)
-#define FD_ACCEPT (1<<5)
-#define SOCK_FD_ERROR (1<<6)
-
-#define sock_connect(s, addr, len) connect((s), (addr), (len))
-#define sock_listen(s, b) listen((s), (b))
-#define sock_bind(s, addr, len) bind((s), (addr), (len))
-#define sock_getopt(s,t,n,v,l) getsockopt((s),(t),(n),(v),(l))
-#define sock_setopt(s,t,n,v,l) setsockopt((s),(t),(n),(v),(l))
-#define sock_name(s, addr, len) getsockname((s), (addr), (len))
-#define sock_peer(s, addr, len) getpeername((s), (addr), (len))
-#define sock_ntohs(x) ntohs((x))
-#define sock_ntohl(x) ntohl((x))
-#define sock_htons(x) htons((x))
-#define sock_htonl(x) htonl((x))
-
-#define sock_accept(s, addr, len) accept((s), (addr), (len))
-#define sock_send(s,buf,len,flag) inet_send((s),(buf),(len),(flag))
-#define sock_sendto(s,buf,blen,flag,addr,alen) \
- sendto((s),(buf),(blen),(flag),(addr),(alen))
-#define sock_sendv(s, vec, size, np, flag) \
- (*(np) = writev_fallback((s), (struct iovec*)(vec), (size), (*(np))))
-#define sock_sendmsg(s,msghdr,flag) sendmsg((s),(msghdr),(flag))
-
-#define sock_open(af, type, proto) socket((af), (type), (proto))
-#define sock_close(s) close((s))
-#define sock_dup(s) dup((s))
-#define sock_shutdown(s, how) shutdown((s), (how))
-
-#define sock_hostname(buf, len) gethostname((buf), (len))
-#define sock_getservbyname(name,proto) getservbyname((name), (proto))
-#define sock_getservbyport(port,proto) getservbyport((port), (proto))
-
-#define sock_recv(s,buf,len,flag) recv((s),(buf),(len),(flag))
-#define sock_recvfrom(s,buf,blen,flag,addr,alen) \
- recvfrom((s),(buf),(blen),(flag),(addr),(alen))
-#define sock_recvmsg(s,msghdr,flag) recvmsg((s),(msghdr),(flag))
-
-#define sock_errno() errno
-#define sock_create_event(d) ((d)->s) /* return file descriptor */
-#define sock_close_event(e) /* do nothing */
-
-#ifndef WANT_NONBLOCKING
-#define WANT_NONBLOCKING
-#endif
-#include "sys.h"
-
-typedef unsigned long u_long;
-#define IN_CLASSA(a) ((((in_addr_t)(a)) & 0x80000000) == 0)
-#define IN_CLASSA_NET 0xff000000
-#define IN_CLASSA_NSHIFT 24
-#define IN_CLASSA_HOST (0xffffffff & ~IN_CLASSA_NET)
-#define IN_CLASSA_MAX 128
-
-#define IN_CLASSB(a) ((((in_addr_t)(a)) & 0xc0000000) == 0x80000000)
-#define IN_CLASSB_NET 0xffff0000
-#define IN_CLASSB_NSHIFT 16
-#define IN_CLASSB_HOST (0xffffffff & ~IN_CLASSB_NET)
-#define IN_CLASSB_MAX 65536
-
-#define IN_CLASSC(a) ((((in_addr_t)(a)) & 0xe0000000) == 0xc0000000)
-#define IN_CLASSC_NET 0xffffff00
-#define IN_CLASSC_NSHIFT 8
-#define IN_CLASSC_HOST (0xffffffff & ~IN_CLASSC_NET)
-
-#define IN_CLASSD(a) ((((in_addr_t)(a)) & 0xf0000000) == 0xe0000000)
-#define IN_MULTICAST(a) IN_CLASSD(a)
-
-#define IN_EXPERIMENTAL(a) ((((in_addr_t)(a)) & 0xe0000000) == 0xe0000000)
-#define IN_BADCLASS(a) ((((in_addr_t)(a)) & 0xf0000000) == 0xf0000000)
-
-#define sock_select(d, flags, onoff) do { \
- ASSERT(!(d)->is_ignored); \
- (d)->event_mask = (onoff) ? \
- ((d)->event_mask | (flags)) : \
- ((d)->event_mask & ~(flags)); \
- DEBUGF(("(%s / %d) sock_select(%ld): flags=%02X, onoff=%d, event_mask=%02lX, s=%d\r\n", \
- __FILE__, __LINE__, (long) (d)->port, (flags), (onoff), (unsigned long) (d)->event_mask, (d)->s)); \
- inet_driver_select((d), (flags), (onoff)); \
- } while(0)
-
-#define TCP_SHUT_WR SHUT_WR
-#define TCP_SHUT_RD SHUT_RD
-#define TCP_SHUT_RDWR SHUT_RDWR
-
-#else /* !__OSE__ && !__WIN32__ */
+#else /* !__WIN32__ */
#include <sys/time.h>
#ifdef NETDB_H_NEEDS_IN_H
@@ -704,7 +568,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
#define TCP_SHUT_RD SHUT_RD
#define TCP_SHUT_RDWR SHUT_RDWR
-#endif /* !__WIN32__ && !__OSE__ */
+#endif /* !__WIN32__ */
#ifdef HAVE_SOCKLEN_T
# define SOCKLEN_T socklen_t
@@ -1168,13 +1032,6 @@ typedef struct {
char *netns; /* Socket network namespace name
as full file path */
#endif
-#ifdef __OSE__
- int select_state; /* state to keep track of whether we
- should trigger another read/write
- request at end of ready_input/output */
- ErlDrvEvent events[6];
-#endif
-
} inet_descriptor;
@@ -1190,10 +1047,8 @@ static void tcp_inet_stop(ErlDrvData);
static void tcp_inet_command(ErlDrvData, char*, ErlDrvSizeT);
static void tcp_inet_commandv(ErlDrvData, ErlIOVec*);
static void tcp_inet_flush(ErlDrvData drv_data);
-#ifndef __OSE__
static void tcp_inet_drv_input(ErlDrvData, ErlDrvEvent);
static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event);
-#endif
static ErlDrvData tcp_inet_start(ErlDrvPort, char* command);
static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData, unsigned int,
char*, ErlDrvSizeT, char**, ErlDrvSizeT);
@@ -1206,71 +1061,6 @@ static void tcp_inet_event(ErlDrvData, ErlDrvEvent);
static void find_dynamic_functions(void);
#endif
-#ifdef __OSE__
-/* The structure of the signal used for requesting asynchronous
- * notification from the stack. Under normal circumstances the network stack
- * shouldn't overwrite the value set in the fd field by the sender
- * of the request */
-struct OseAsyncSig {
- struct FmEvent event;
- int fd;
-};
-
-union SIGNAL {
- SIGSELECT signo;
- struct OseAsyncSig async;
-};
-
-static ErlDrvSSizeT tcp_inet_ctl_ose(ErlDrvData e, unsigned int cmd,
- char* buf, ErlDrvSizeT len,
- char** rbuf, ErlDrvSizeT rsize);
-static void tcp_inet_commandv_ose(ErlDrvData e, ErlIOVec* ev);
-static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event);
-static void tcp_inet_drv_input_ose(ErlDrvData data, ErlDrvEvent event);
-static ErlDrvOseEventId inet_resolve_signal(union SIGNAL *sig);
-
-#ifdef INET_DRV_DEBUG
-
-static char *read_req = "SO_EVENT_READ_REQUEST";
-static char *read_rep = "SO_EVENT_READ_REPLY";
-static char *write_req = "SO_EVENT_WRITE_REQUEST";
-static char *write_rep = "SO_EVENT_WRITE_REPLY";
-static char *eof_req = "SO_EVENT_EOF_REQUEST";
-static char *eof_rep = "SO_EVENT_EOF_REPLY";
-static char *accept_req = "SO_EVENT_ACCEPT_REQUEST";
-static char *accept_rep = "SO_EVENT_ACCEPT_REPLY";
-static char *connect_req = "SO_EVENT_CONNECT_REQUEST";
-static char *connect_rep = "SO_EVENT_CONNECT_REPLY";
-static char *error_req = "SO_EVENT_ERROR_REQUEST";
-static char *error_rep = "SO_EVENT_ERROR_REPLY";
-static char signo_tmp[32];
-
-static char *signo_to_string(SIGSELECT signo) {
- switch (signo) {
- case SO_EVENT_READ_REQUEST: { return read_req; }
- case SO_EVENT_READ_REPLY: { return read_rep; }
- case SO_EVENT_WRITE_REQUEST: { return write_req; }
- case SO_EVENT_WRITE_REPLY: { return write_rep; }
- case SO_EVENT_EOF_REQUEST: { return eof_req; }
- case SO_EVENT_EOF_REPLY: { return eof_rep; }
- case SO_EVENT_ACCEPT_REQUEST: { return accept_req; }
- case SO_EVENT_ACCEPT_REPLY: { return accept_rep; }
- case SO_EVENT_CONNECT_REQUEST: { return connect_req; }
- case SO_EVENT_CONNECT_REPLY: { return connect_rep; }
- case SO_EVENT_ERROR_REQUEST: { return error_req; }
- case SO_EVENT_ERROR_REPLY: { return error_rep; }
- }
-
- snprintf(signo_tmp,32,"0x%x",signo);
-
- return signo_tmp;
-}
-
-#endif
-
-#endif /* __OSE__ */
-
-
static struct erl_drv_entry tcp_inet_driver_entry =
{
tcp_inet_init, /* inet_init will add this driver !! */
@@ -1280,9 +1070,6 @@ static struct erl_drv_entry tcp_inet_driver_entry =
#ifdef __WIN32__
tcp_inet_event,
NULL,
-#elif defined(__OSE__)
- tcp_inet_drv_input_ose, /*ready_input*/
- tcp_inet_drv_output_ose, /*ready_output*/
#else
tcp_inet_drv_input,
tcp_inet_drv_output,
@@ -1290,17 +1077,9 @@ static struct erl_drv_entry tcp_inet_driver_entry =
"tcp_inet",
NULL,
NULL,
-#ifdef __OSE__
- tcp_inet_ctl_ose,
-#else
tcp_inet_ctl,
-#endif
tcp_inet_timeout,
-#ifdef __OSE__
- tcp_inet_commandv_ose,
-#else
tcp_inet_commandv,
-#endif
NULL,
tcp_inet_flush,
NULL,
@@ -1452,14 +1231,6 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event);
/* convert descriptor pointer to inet_descriptor pointer */
#define INETP(d) (&(d)->inet)
-#ifdef __OSE__
-static void inet_driver_select(inet_descriptor* desc,
- int flags, int onoff);
-static void tcp_inet_ose_dispatch_signals(tcp_descriptor *desc,
- int prev_select_state,
- union SIGNAL *sig);
-#endif
-
static int async_ref = 0; /* async reference id generator */
#define NEW_ASYNC_ID() ((async_ref++) & 0xffff)
@@ -4355,16 +4126,6 @@ static void desc_close(inet_descriptor* desc)
desc->forced_events = 0;
desc->send_would_block = 0;
#endif
-#ifdef __OSE__
- if (desc->events[0]) {
- driver_select(desc->port,desc->events[0],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[1],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[2],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[3],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[4],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[5],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- }
-#else
/*
* We should close the fd here, but the other driver might still
* be selecting on it.
@@ -4374,7 +4135,6 @@ static void desc_close(inet_descriptor* desc)
ERL_DRV_USE, 0);
else
inet_stop_select((ErlDrvEvent)(long)desc->event,NULL);
-#endif
desc->event = INVALID_EVENT; /* closed by stop_select callback */
desc->s = INVALID_SOCKET;
desc->event_mask = 0;
@@ -4416,65 +4176,6 @@ static int erl_inet_close(inet_descriptor* desc)
return 0;
}
-#ifdef __OSE__
-static void inet_select_init(inet_descriptor* desc)
-{
- desc->events[0] =
- erl_drv_ose_event_alloc(SO_EVENT_READ_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[0],
- ERL_DRV_READ|ERL_DRV_USE, 1);
-
- desc->events[1] =
- erl_drv_ose_event_alloc(SO_EVENT_EOF_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[1],
- ERL_DRV_READ|ERL_DRV_USE, 1);
-
- desc->events[2] =
- erl_drv_ose_event_alloc(SO_EVENT_ACCEPT_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[2],
- ERL_DRV_READ|ERL_DRV_USE, 1);
-
- /* trigger tcp_inet_input */
- desc->events[3] =
- erl_drv_ose_event_alloc(SO_EVENT_WRITE_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[3],
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
-
- desc->events[4] =
- erl_drv_ose_event_alloc(SO_EVENT_CONNECT_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[4],
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
-
- desc->events[5] =
- erl_drv_ose_event_alloc(SO_EVENT_ERROR_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[5],
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
-
- /* Issue a select on error event before any other select to be sure we are
- prepared to receive error notifications from the stack, even in the
- situations when select isn't issued */
- sock_select(desc, SOCK_FD_ERROR, 1);
-}
-#endif
-
static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type,
char** rbuf, ErlDrvSizeT rsize)
{
@@ -4557,9 +4258,6 @@ static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type,
#ifdef __WIN32__
driver_select(desc->port, desc->event, ERL_DRV_READ, 1);
#endif
-#ifdef __OSE__
- inet_select_init(desc);
-#endif
desc->state = INET_STATE_OPEN;
desc->stype = type;
@@ -4583,13 +4281,7 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type,
if (name.sa.sa_family != domain)
return ctl_error(EINVAL, rbuf, rsize);
}
-#ifdef __OSE__
- /* for fdopen duplicating the sd will allow to uniquely identify
- the signal from OSE with erlang port */
- desc->s = sock_dup(s);
-#else
desc->s = s;
-#endif
if ((desc->event = sock_create_event(desc)) == INVALID_EVENT)
return ctl_error(sock_errno(), rbuf, rsize);
@@ -4607,12 +4299,6 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type,
sz = sizeof(name);
if (!IS_SOCKET_ERROR(sock_peer(s, (struct sockaddr*) &name, &sz))) {
desc->state = INET_STATE_CONNECTED;
-#ifdef __OSE__
- /* since we are dealing with different descriptors (i.e. inet and
- socket) the select part should be initialized with the right
- values */
- inet_select_init(desc);
-#endif
}
}
@@ -8414,15 +8100,6 @@ static ErlDrvData inet_start(ErlDrvPort port, int size, int protocol)
#ifdef HAVE_SETNS
desc->netns = NULL;
#endif
-#ifdef __OSE__
- desc->select_state = 0;
- desc->events[0] = NULL;
- desc->events[1] = NULL;
- desc->events[2] = NULL;
- desc->events[3] = NULL;
- desc->events[4] = NULL;
- desc->events[5] = NULL;
-#endif
return (ErlDrvData)desc;
}
@@ -9149,10 +8826,6 @@ static tcp_descriptor* tcp_inet_copy(tcp_descriptor* desc,SOCKET s,
copy_desc->inet.port = port;
copy_desc->inet.dport = driver_mk_port(port);
-#ifdef __OSE__
- inet_select_init(&copy_desc->inet);
-#endif
-
*err = 0;
return copy_desc;
}
@@ -9214,23 +8887,6 @@ static void tcp_inet_stop(ErlDrvData e)
inet_stop(INETP(desc));
}
-#ifdef __OSE__
-
-static ErlDrvSSizeT tcp_inet_ctl_ose(ErlDrvData e, unsigned int cmd,
- char* buf, ErlDrvSizeT len,
- char** rbuf, ErlDrvSizeT rsize) {
-
- tcp_descriptor* desc = (tcp_descriptor*)e;
- int prev_select_state = INETP(desc)->select_state;
-
- ErlDrvSSizeT res = tcp_inet_ctl(e,cmd,buf,len,rbuf,rsize);
-
- tcp_inet_ose_dispatch_signals((tcp_descriptor*)e,prev_select_state,NULL);
-
- return res;
-}
-#endif
-
/* TCP requests from Erlang */
static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
char* buf, ErlDrvSizeT len,
@@ -9672,17 +9328,6 @@ static void tcp_inet_command(ErlDrvData e, char *buf, ErlDrvSizeT len)
DEBUGF(("tcp_inet_command(%ld) }\r\n", (long)desc->inet.port));
}
-#ifdef __OSE__
-
-static void tcp_inet_commandv_ose(ErlDrvData e, ErlIOVec* ev) {
- int prev_select_state = INETP((tcp_descriptor*)e)->select_state;
- tcp_inet_commandv(e, ev);
- tcp_inet_ose_dispatch_signals((tcp_descriptor*)e,prev_select_state,NULL);
-}
-
-#endif
-
-
static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev)
{
tcp_descriptor* desc = (tcp_descriptor*)e;
@@ -9755,22 +9400,6 @@ static void inet_stop_select(ErlDrvEvent event, void* _)
{
#ifdef __WIN32__
WSACloseEvent((HANDLE)event);
-#elif defined(__OSE__)
- ErlDrvOseEventId id;
- union SIGNAL *sig;
- erl_drv_ose_event_fetch(event, NULL, &id,NULL);
- DEBUGF(("inet_stop_select(?#?) {s=%d\n",id));
- sock_close((int)id);
- /* On socket close all the signals waiting to be processed as part of the
- select should be deallocated */
- while((sig = erl_drv_ose_get_signal(event))) {
- DEBUGF(("inet_stop_select(?#?): Freeing signal %s\n",
- signo_to_string(sig->signo)));
- free_buf(&sig);
- }
- erl_drv_ose_event_free(event);
- DEBUGF(("inet_stop_select(?#?) }\n"));
-
#else
sock_close((SOCKET)(long)event);
#endif
@@ -10319,146 +9948,7 @@ static void tcp_inet_event(ErlDrvData e, ErlDrvEvent event)
return;
}
-#elif defined(__OSE__) /* !__WIN32__ */
-/* The specific resolve signal function. It will return the socket descriptor
- for which the select was issued */
-static ErlDrvOseEventId inet_resolve_signal(union SIGNAL *sig) {
- DEBUGF(("%s(?#?): s=%d got signal %s, status = %d, extra = %d, sender = 0x%x\n",
- __FUNCTION__,sig->async.fd,signo_to_string(sig->signo),
- sig->async.event.status,
- sig->async.event.extra,sender(&sig)));
- if (sig->signo == SO_EVENT_READ_REPLY ||
- sig->signo == SO_EVENT_ACCEPT_REPLY ||
- sig->signo == SO_EVENT_EOF_REPLY ||
- sig->signo == SO_EVENT_WRITE_REPLY ||
- sig->signo == SO_EVENT_ERROR_REPLY ||
- sig->signo == SO_EVENT_CONNECT_REPLY ) {
- return sig->async.fd;
- }
-
- return -1;
-}
-
-static void inet_driver_select(inet_descriptor* desc,
- int flags, int onoff) {
- ASSERT(!desc->is_ignored);
-
- if(onoff) {
- desc->select_state |= flags;
- } else {
- desc->select_state &= ~flags;
- }
-}
-
-static ssize_t writev_fallback(int fd, const struct iovec *iov, int iovcnt, int max_sz)
-{
- size_t data_len = 0;
- size_t sent = 0;
- ssize_t n;
- int i;
-
- for(i = 0; i < iovcnt; i++)
- {
- data_len = iov[i].iov_len;
-tryagain:
- n = sock_send(fd, iov[i].iov_base, data_len, 0);
- if (IS_SOCKET_ERROR(n)) {
- /* If buffer length is greater than the amount stack is able to
- * send out then try to send at least max_sz (this comes with
- * SO_EVENT_WRITE_REPLY signal*/
- if ((errno == EMSGSIZE) && (max_sz > 0) && (data_len > max_sz)) {
- data_len = max_sz;
- goto tryagain;
- }
- break;
- }
- sent += n;
- }
- return sent;
-}
-
-#define OSE_EVENT_REQ(TCP_DESC,EVENT) do { \
- union SIGNAL *sig = alloc(sizeof(struct OseAsyncSig), EVENT); \
- sig->async.fd = INETP(TCP_DESC)->s; \
- ose_request_event(INETP(TCP_DESC)->s, &sig, 1); \
- DEBUGF(("%s(%ld): s=%d sent %s\r\n",__FUNCTION__, \
- INETP(TCP_DESC)->port,INETP(TCP_DESC)->s,signo_to_string(EVENT))); \
- } while(0)
-
-static void tcp_inet_ose_dispatch_signals(tcp_descriptor *desc,
- int prev_select_state,
- union SIGNAL *sig) {
- if (sig) {
- DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) {s=%d resend\r\n",
- (long)INETP(desc)->port,INETP(desc)->s));
- /* We are reacting to a signal, which means that if
- the select_state for that signal is still activated
- we should send a new signal */
- switch (sig->signo) {
- case SO_EVENT_READ_REPLY: {
- if (INETP(desc)->select_state & FD_READ)
- OSE_EVENT_REQ(desc,SO_EVENT_READ_REQUEST);
- break;
- }
- case SO_EVENT_WRITE_REPLY: {
- if (INETP(desc)->select_state & FD_WRITE)
- OSE_EVENT_REQ(desc,SO_EVENT_WRITE_REQUEST);
- break;
- }
- case SO_EVENT_CONNECT_REPLY: {
- if (INETP(desc)->select_state & FD_CONNECT)
- OSE_EVENT_REQ(desc,SO_EVENT_CONNECT_REQUEST);
- break;
- }
- case SO_EVENT_ACCEPT_REPLY: {
- if (INETP(desc)->select_state & FD_ACCEPT)
- OSE_EVENT_REQ(desc,SO_EVENT_ACCEPT_REQUEST);
- break;
- }
- case SO_EVENT_ERROR_REPLY: {
- if (INETP(desc)->select_state & SOCK_FD_ERROR)
- OSE_EVENT_REQ(desc,SO_EVENT_ERROR_REQUEST);
- break;
- }
-
- }
- DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) }\r\n",
- (long)INETP(desc)->port));
- }
-
- if (INETP(desc)->select_state != prev_select_state) {
- /* If the select state has changed we have to issue signals for
- the state parts that have changed. */
- int xor_select_state = INETP(desc)->select_state ^ prev_select_state;
- DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) {s=%d select change\r\n",
- (long)INETP(desc)->port,INETP(desc)->s));
- if ((xor_select_state & FD_READ) &&
- (INETP(desc)->select_state & FD_READ)) {
- OSE_EVENT_REQ(desc,SO_EVENT_READ_REQUEST);
- }
- if ((xor_select_state & FD_WRITE) &&
- (INETP(desc)->select_state & FD_WRITE)) {
- OSE_EVENT_REQ(desc,SO_EVENT_WRITE_REQUEST);
- }
- if ((xor_select_state & FD_CONNECT) &&
- (INETP(desc)->select_state & FD_CONNECT)) {
- OSE_EVENT_REQ(desc,SO_EVENT_CONNECT_REQUEST);
- }
- if ((xor_select_state & FD_ACCEPT) &&
- (INETP(desc)->select_state & FD_ACCEPT)) {
- OSE_EVENT_REQ(desc,SO_EVENT_ACCEPT_REQUEST);
- }
- if ((xor_select_state & SOCK_FD_ERROR) &&
- (INETP(desc)->select_state & SOCK_FD_ERROR)) {
- OSE_EVENT_REQ(desc,SO_EVENT_ERROR_REQUEST);
- }
-
- DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) }\r\n",
- (long)INETP(desc)->port));
- }
-}
-
-#endif /* __OSE__ */
+#endif /* __WIN32__ */
/* socket has input:
@@ -10945,49 +10435,6 @@ static void tcp_shutdown_async(tcp_descriptor* desc)
desc->tcp_add_flags |= TCP_ADDF_SHUTDOWN_WR_DONE;
}
-#ifdef __OSE__
-
-static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event)
-{
- union SIGNAL *event_sig = erl_drv_ose_get_signal(event);
-
- while (event_sig) {
- int prev_select_state = INETP((tcp_descriptor*)data)->select_state;
- int res = tcp_inet_output((tcp_descriptor*)data, (HANDLE)event_sig);
- if (res != -1) {
- tcp_inet_ose_dispatch_signals((tcp_descriptor*)data,
- prev_select_state,event_sig);
- free_buf(&event_sig);
- event_sig = erl_drv_ose_get_signal(event);
- } else {
- /* NOTE: here the event object could have been deallocated!!!!
- inet_stop_select is called when doing driver_select(ERL_DRV_USE,0)
- */
- free_buf(&event_sig);
- return;
- }
- }
-}
-
-static void tcp_inet_drv_input_ose(ErlDrvData data, ErlDrvEvent event)
-{
- union SIGNAL *event_sig = erl_drv_ose_get_signal(event);
-
- while (event_sig) {
- int prev_select_state = INETP((tcp_descriptor*)data)->select_state;
- int res = tcp_inet_input((tcp_descriptor*)data, (HANDLE)event);
- if (res != -1) {
- tcp_inet_ose_dispatch_signals((tcp_descriptor*)data, prev_select_state,
- event_sig);
- free_buf(&event_sig);
- event_sig = erl_drv_ose_get_signal(event);
- } else {
- free_buf(&event_sig);
- return;
- }
- }
-}
-#else
static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event)
{
(void)tcp_inet_output((tcp_descriptor*)data, (HANDLE)event);
@@ -10997,7 +10444,6 @@ static void tcp_inet_drv_input(ErlDrvData data, ErlDrvEvent event)
{
(void)tcp_inet_input((tcp_descriptor*)data, (HANDLE)event);
}
-#endif
/* socket ready for ouput:
** 1. INET_STATE_CONNECTING => non block connect ?
@@ -11063,13 +10509,6 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
ssize_t n;
SysIOVec* iov;
-#ifdef __OSE__
- /* For large size buffers case the amount of data that the stack is
- able to send out (received in the .extra field) should be passed
- down to writev_fallback */
- n = event ? ((union SIGNAL*)event)->async.event.extra : 0;
-#endif
-
if ((iov = driver_peekq(ix, &vsize)) == NULL) {
sock_select(INETP(desc), FD_WRITE, 0);
send_empty_out_q_msgs(INETP(desc));
@@ -11097,12 +10536,6 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
sizes > (max 32 bit signed int) */
size_t howmuch = 0x7FFFFFFF; /* max signed 32 bit */
int x;
-#ifdef __OSE__
- /* For EWOULDBLOCK sock_sendv returns 0 so we have to be sure it
- wasn't the case */
- if(sock_errno() == ERRNO_BLOCK)
- goto done;
-#endif
for(x = 0; x < vsize && iov[x].iov_len == 0; ++x)
;
if (x < vsize) {
diff --git a/erts/emulator/drivers/ose/ose_efile.c b/erts/emulator/drivers/ose/ose_efile.c
deleted file mode 100644
index c8337a95d5..0000000000
--- a/erts/emulator/drivers/ose/ose_efile.c
+++ /dev/null
@@ -1,1125 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2012. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Purpose: Provides file and directory operations for OSE.
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-#if defined(HAVE_POSIX_FALLOCATE) && !defined(__sun) && !defined(__sun__)
-#define _XOPEN_SOURCE 600
-#endif
-#if !defined(_GNU_SOURCE) && defined(HAVE_LINUX_FALLOC_H)
-#define _GNU_SOURCE
-#endif
-#include "sys.h"
-#include "erl_driver.h"
-#include "erl_efile.h"
-#if defined(DARWIN) || defined(HAVE_LINUX_FALLOC_H) || defined(HAVE_POSIX_FALLOCATE)
-#include "fcntl.h"
-#endif
-#include "ose.h"
-#include "unistd.h"
-#include "sys/stat.h"
-#include "dirent.h"
-#include "sys/time.h"
-#include "time.h"
-#include "assert.h"
-
-/* Find a definition of MAXIOV, that is used in the code later. */
-#if defined IOV_MAX
-#define MAXIOV IOV_MAX
-#elif defined UIO_MAXIOV
-#define MAXIOV UIO_MAXIOV
-#else
-#define MAXIOV 16
-#endif
-
-/*
- * Macros for testing file types.
- */
-
-#define ISDIR(st) (((st).st_mode & S_IFMT) == S_IFDIR)
-#define ISREG(st) (((st).st_mode & S_IFMT) == S_IFREG)
-#define ISDEV(st) \
- (((st).st_mode&S_IFMT) == S_IFCHR || ((st).st_mode&S_IFMT) == S_IFBLK)
-#define ISLNK(st) (((st).st_mode & S_IFLNK) == S_IFLNK)
-#ifdef NO_UMASK
-#define FILE_MODE 0644
-#define DIR_MODE 0755
-#else
-#define FILE_MODE 0666
-#define DIR_MODE 0777
-#endif
-
-#define IS_DOT_OR_DOTDOT(s) \
- (s[0] == '.' && (s[1] == '\0' || (s[1] == '.' && s[2] == '\0')))
-
-/*
- * Macros for handling local file descriptors
- * and mutexes.
- *
- * Handling of files like this is necessary because OSE
- * does not allow seeking after the end of a file. So
- * what we do it emulate this by keeping track of the size
- * of the file and where the file's positions is. If a
- * write happens after eof then we pad it.
- *
- * Given time this should be rewritten to get rid of the
- * mutex and use the port lock to protect the data. This
- * could be done be done by adapting the efile api for some
- * calls to allow some meta-data to be associated with the
- * open file.
- */
-
-#define L_FD_IS_VALID(fd_data) ((fd_data)->beyond_eof > 0)
-#define L_FD_INVALIDATE(fd_data) (fd_data)->beyond_eof = 0
-#define L_FD_CUR(fd_data) (fd_data)->pos
-#define L_FD_OFFS_BEYOND_EOF(fd_data, offs) \
- (((fd_data)->size > offs) ? 0 : 1)
-
-#define L_FD_FAIL -1
-#define L_FD_SUCCESS 1
-#define L_FD_PAD_SIZE 255
-
-struct fd_meta {
- ErlDrvMutex *meta_mtx;
- struct fd_data *fd_data_list;
-};
-
-struct fd_data {
- int fd;
- struct fd_data *next;
- struct fd_data *prev;
- int pos;
- int beyond_eof;
- size_t size;
-#ifdef DEBUG
- PROCESS owner;
-#endif
-};
-
-static int l_invalidate_local_fd(int fd);
-static int l_pad_file(struct fd_data *fd_data, off_t offset);
-static int check_error(int result, Efile_error* errInfo);
-static struct fd_data* l_new_fd(void);
-static int l_remove_local_fd(int fd);
-static struct fd_data* l_find_local_fd(int fd);
-static int l_update_local_fd(int fd, int pos, int size);
-
-static struct fd_meta* fdm = NULL;
-
-
-/***************************************************************************/
-
-static int
-l_remove_local_fd(int fd)
-{
- struct fd_data *fd_data;
- fd_data = l_find_local_fd(fd);
-
- if (fd_data == NULL) {
- return L_FD_FAIL;
- }
-#ifdef DEBUG
- assert(fd_data->owner == current_process());
-#endif
- erl_drv_mutex_lock(fdm->meta_mtx);
- /* head ? */
- if (fd_data == fdm->fd_data_list) {
- if (fd_data->next != NULL) {
- /* remove link to head */
- fd_data->next->prev = NULL;
- /* set new head */
- fdm->fd_data_list = fd_data->next;
- }
- else {
- /* head is lonely */
- fdm->fd_data_list = NULL;
- }
- }
- else { /* not head */
- if (fd_data->prev == NULL) {
- erl_drv_mutex_unlock(fdm->meta_mtx);
- return L_FD_FAIL;
- }
- else {
- if (fd_data->next != NULL) {
- fd_data->next->prev = fd_data->prev;
- fd_data->prev->next = fd_data->next;
- }
- else {
- fd_data->prev->next = NULL;
- }
- }
- }
-
- /* scramble values */
- fd_data->beyond_eof = -1;
- fd_data->next = NULL;
- fd_data->prev = NULL;
- fd_data->fd = -1;
-
- /* unlock and clean */
- driver_free(fd_data);
- erl_drv_mutex_unlock(fdm->meta_mtx);
-
- return L_FD_SUCCESS;
-}
-
-/***************************************************************************/
-
-static int
-l_invalidate_local_fd(int fd) {
- struct fd_data *fd_data;
-
- if ((fd_data = l_find_local_fd(fd)) == NULL) {
- return L_FD_FAIL;
- }
-
- fd_data->beyond_eof = 0;
- return L_FD_SUCCESS;
-}
-
-/****************************************************************************/
-
-static struct fd_data*
-l_find_local_fd(int fd) {
- struct fd_data *fd_data;
-
- fd_data = NULL;
- erl_drv_mutex_lock(fdm->meta_mtx);
- for (fd_data = fdm->fd_data_list; fd_data != NULL; ) {
- if (fd_data->fd == fd) {
-#ifdef DEBUG
- assert(fd_data->owner == current_process());
-#endif
- break;
- }
- fd_data = fd_data->next;
- }
- erl_drv_mutex_unlock(fdm->meta_mtx);
- return fd_data;
-}
-
-/***************************************************************************/
-
-static struct fd_data*
-l_new_fd(void) {
- struct fd_data *fd_data;
-
- fd_data = driver_alloc(sizeof(struct fd_data));
- if (fd_data == NULL) {
- return NULL;
- }
- erl_drv_mutex_lock(fdm->meta_mtx);
- if (fdm->fd_data_list == NULL) {
- fdm->fd_data_list = fd_data;
- fdm->fd_data_list->prev = NULL;
- fdm->fd_data_list->next = NULL;
- }
- else {
- fd_data->next = fdm->fd_data_list;
- fdm->fd_data_list = fd_data;
- fdm->fd_data_list->prev = NULL;
- }
-#ifdef DEBUG
- fd_data->owner = current_process();
-#endif
- erl_drv_mutex_unlock(fdm->meta_mtx);
- return fd_data;
-}
-
-/***************************************************************************/
-
-static int
-l_update_local_fd(int fd, int pos, int size) {
- struct fd_data *fd_data = NULL;
-
- fd_data = l_find_local_fd(fd);
- /* new fd to handle? */
- if (fd_data == NULL) {
- fd_data = l_new_fd();
- if (fd_data == NULL) {
- /* out of memory */
- return L_FD_FAIL;
- }
- }
- fd_data->size = size;
- fd_data->pos = pos;
- fd_data->fd = fd;
- fd_data->beyond_eof = 1;
-
- return L_FD_SUCCESS;
-}
-
-/***************************************************************************/
-
-static int
-l_pad_file(struct fd_data *fd_data, off_t offset) {
- int size_dif;
- int written = 0;
- int ret_val = L_FD_SUCCESS;
- char padding[L_FD_PAD_SIZE];
-
- size_dif = (offset - fd_data->size);
- memset(&padding, '\0', L_FD_PAD_SIZE);
-
- while (size_dif > 0) {
- written = write(fd_data->fd, padding,
- (size_dif < L_FD_PAD_SIZE) ?
- size_dif : L_FD_PAD_SIZE);
- if (written < 0 && errno != EINTR && errno != EAGAIN) {
- ret_val = -1;
- break;
- }
- size_dif -= written;
- }
- L_FD_INVALIDATE(fd_data);
- return ret_val;
-}
-
-/***************************************************************************/
-
-static int
-check_error(int result, Efile_error *errInfo) {
- if (result < 0) {
- errInfo->posix_errno = errInfo->os_errno = errno;
- return 0;
- }
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_init() {
- fdm = driver_alloc(sizeof(struct fd_meta));
- if (fdm == NULL) {
- return L_FD_FAIL;
- }
- fdm->meta_mtx = erl_drv_mutex_create("ose_efile local fd mutex\n");
- erl_drv_mutex_lock(fdm->meta_mtx);
- fdm->fd_data_list = NULL;
- erl_drv_mutex_unlock(fdm->meta_mtx);
- return L_FD_SUCCESS;
-}
-
-/***************************************************************************/
-
-int
-efile_mkdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of directory to create. */
-{
-#ifdef NO_MKDIR_MODE
- return check_error(mkdir(name), errInfo);
-#else
- int res = mkdir(name, DIR_MODE);
- if (res < 0 && errno == EINVAL) {
- errno = ENOENT;
- }
- return check_error(res, errInfo);
-#endif
-}
-
-/***************************************************************************/
-
-int
-efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of directory to delete. */
-{
- if (rmdir(name) == 0) {
- return 1;
- }
- if (errno == ENOTEMPTY) {
- errno = EEXIST;
- }
- if (errno == EEXIST || errno == EINVAL) {
- int saved_errno = errno;
- struct stat file_stat;
- struct stat cwd_stat;
-
- if(stat(name, &file_stat) != 0) {
- errno = ENOENT;
- return check_error(-1, errInfo);
- }
- /*
- * The error code might be wrong if this is the current directory.
- */
- if (stat(name, &file_stat) == 0 && stat(".", &cwd_stat) == 0 &&
- file_stat.st_ino == cwd_stat.st_ino &&
- file_stat.st_dev == cwd_stat.st_dev) {
- saved_errno = EACCES;
- }
- errno = saved_errno;
- }
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of file to delete. */
-{
- struct stat statbuf;
-
- if (stat(name, &statbuf) >= 0) {
- /* Do not let unlink() remove directories */
- if (ISDIR(statbuf)) {
- errno = EPERM;
- return check_error(-1, errInfo);
- }
-
- if (unlink(name) == 0) {
- return 1;
- }
-
- if (errno == EISDIR) {
- errno = EPERM;
- return check_error(-1, errInfo);
- }
- }
- else {
- if (errno == EINVAL) {
- errno = ENOENT;
- return check_error(-1, errInfo);
- }
- }
- return check_error(-1, errInfo);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Changes the name of an existing file or directory, from src to dst.
- * If src and dst refer to the same file or directory, does nothing
- * and returns success. Otherwise if dst already exists, it will be
- * deleted and replaced by src subject to the following conditions:
- * If src is a directory, dst may be an empty directory.
- * If src is a file, dst may be a file.
- * In any other situation where dst already exists, the rename will
- * fail.
- *
- * Results:
- * If the directory was successfully created, returns 1.
- * Otherwise the return value is 0 and errno is set to
- * indicate the error. Some possible values for errno are:
- *
- * EACCES: src or dst parent directory can't be read and/or written.
- * EEXIST: dst is a non-empty directory.
- * EINVAL: src is a root directory or dst is a subdirectory of src.
- * EISDIR: dst is a directory, but src is not.
- * ENOENT: src doesn't exist, or src or dst is "".
- * ENOTDIR: src is a directory, but dst is not.
- * EXDEV: src and dst are on different filesystems.
- *
- * Side effects:
- * The implementation of rename may allow cross-filesystem renames,
- * but the caller should be prepared to emulate it with copy and
- * delete if errno is EXDEV.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-efile_rename(Efile_error* errInfo, /* Where to return error codes. */
- char* src, /* Original name. */
- char* dst) /* New name. */
-{
-
- /* temporary fix AFM does not recognize ./<file name>
- * in destination remove pending on adaption of AFM fix
- */
-
- char *dot_str;
- if (dst != NULL) {
- dot_str = strchr(dst, '.');
- if (dot_str && dot_str == dst && dot_str[1] == '/') {
- dst = dst+2;
- }
- }
-
- if (rename(src, dst) == 0) {
- return 1;
- }
- if (errno == ENOTEMPTY) {
- errno = EEXIST;
- }
- if (errno == EINVAL) {
- struct stat file_stat;
-
- if (stat(dst, &file_stat)== 0) {
- if (ISDIR(file_stat)) {
- errno = EISDIR;
- }
- else if (ISREG(file_stat)) {
- errno = ENOTDIR;
- }
- else {
- errno = EINVAL;
- }
- }
- else {
- errno = EINVAL;
- }
- }
-
- if (strcmp(src, "/") == 0) {
- errno = EINVAL;
- }
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_chdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of directory to make current. */
-{
- return check_error(chdir(name), errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_getdcwd(Efile_error* errInfo, /* Where to return error codes. */
- int drive, /* 0 - current, 1 - A, 2 - B etc. */
- char* buffer, /* Where to return the current
- directory. */
- size_t size) /* Size of buffer. */
-{
- if (drive == 0) {
- if (getcwd(buffer, size) == NULL)
- return check_error(-1, errInfo);
-
- return 1;
- }
-
- /*
- * Drives other than 0 is not supported on Unix.
- */
-
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_readdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name, /* Name of directory to open. */
- EFILE_DIR_HANDLE* p_dir_handle, /* Pointer to directory
- handle of
- open directory.*/
- char* buffer, /* Pointer to buffer for
- one filename. */
- size_t *size) /* in-out Size of buffer, length
- of name. */
-{
- DIR *dp; /* Pointer to directory structure. */
- struct dirent* dirp; /* Pointer to directory entry. */
-
- /*
- * If this is the first call, we must open the directory.
- */
-
- if (*p_dir_handle == NULL) {
- dp = opendir(name);
- if (dp == NULL)
- return check_error(-1, errInfo);
- *p_dir_handle = (EFILE_DIR_HANDLE) dp;
- }
-
- /*
- * Retrieve the name of the next file using the directory handle.
- */
-
- dp = *((DIR **)((void *)p_dir_handle));
- for (;;) {
- dirp = readdir(dp);
- if (dirp == NULL) {
- closedir(dp);
- return 0;
- }
- if (IS_DOT_OR_DOTDOT(dirp->d_name))
- continue;
- buffer[0] = '\0';
- strncat(buffer, dirp->d_name, (*size)-1);
- *size = strlen(dirp->d_name);
- return 1;
- }
-}
-
-/***************************************************************************/
-
-int
-efile_openfile(Efile_error* errInfo, /* Where to return error codes. */
- char* name, /* Name of directory to open. */
- int flags, /* Flags to user for opening. */
- int* pfd, /* Where to store the file
- descriptor. */
- Sint64 *pSize) /* Where to store the size of the
- file. */
-{
- struct stat statbuf;
- int fd;
- int mode; /* Open mode. */
-
- if (stat(name, &statbuf) >= 0 && !ISREG(statbuf)) {
- errno = EISDIR;
- return check_error(-1, errInfo);
- }
-
- switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) {
- case EFILE_MODE_READ:
- mode = O_RDONLY;
- break;
- case EFILE_MODE_WRITE:
- if (flags & EFILE_NO_TRUNCATE)
- mode = O_WRONLY | O_CREAT;
- else
- mode = O_WRONLY | O_CREAT | O_TRUNC;
- break;
- case EFILE_MODE_READ_WRITE:
- mode = O_RDWR | O_CREAT;
- break;
- default:
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
-
- if (flags & EFILE_MODE_APPEND) {
- mode &= ~O_TRUNC;
- mode |= O_APPEND;
- }
-
- if (flags & EFILE_MODE_EXCL) {
- mode |= O_EXCL;
- }
-
- fd = open(name, mode, FILE_MODE);
-
- if (!check_error(fd, errInfo))
- return 0;
-
- *pfd = fd;
- if (pSize) {
- *pSize = statbuf.st_size;
- }
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_may_openfile(Efile_error* errInfo, char *name) {
- struct stat statbuf; /* Information about the file */
- int result;
-
- result = stat(name, &statbuf);
- if (!check_error(result, errInfo))
- return 0;
- if (!ISREG(statbuf)) {
- errno = EISDIR;
- return check_error(-1, errInfo);
- }
- return 1;
-}
-
-/***************************************************************************/
-
-void
-efile_closefile(int fd)
-{
- if (l_find_local_fd(fd) != NULL) {
- l_remove_local_fd(fd);
- }
- close(fd);
-}
-
-/***************************************************************************/
-
-int
-efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */
- int fd) /* File descriptor for file to sync data. */
-{
- return efile_fsync(errInfo, fd);
-}
-
-/***************************************************************************/
-
-int
-efile_fsync(Efile_error *errInfo, /* Where to return error codes. */
- int fd) /* File descriptor for file to sync. */
-{
- return check_error(fsync(fd), errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo,
- char* name, int info_for_link)
-{
- struct stat statbuf; /* Information about the file */
- int result;
-
- result = stat(name, &statbuf);
- if (!check_error(result, errInfo)) {
- return 0;
- }
-
-#if SIZEOF_OFF_T == 4
- pInfo->size_high = 0;
-#else
- pInfo->size_high = (Uint32)(statbuf.st_size >> 32);
-#endif
- pInfo->size_low = (Uint32)statbuf.st_size;
-
-#ifdef NO_ACCESS
- /* Just look at read/write access for owner. */
-
- pInfo->access = ((statbuf.st_mode >> 6) & 07) >> 1;
-
-#else
- pInfo->access = FA_NONE;
- if (access(name, R_OK) == 0)
- pInfo->access |= FA_READ;
- if (access(name, W_OK) == 0)
- pInfo->access |= FA_WRITE;
-
-#endif
-
- if (ISDEV(statbuf))
- pInfo->type = FT_DEVICE;
- else if (ISDIR(statbuf))
- pInfo->type = FT_DIRECTORY;
- else if (ISREG(statbuf))
- pInfo->type = FT_REGULAR;
- else if (ISLNK(statbuf))
- pInfo->type = FT_SYMLINK;
- else
- pInfo->type = FT_OTHER;
-
- pInfo->accessTime = statbuf.st_atime;
- pInfo->modifyTime = statbuf.st_mtime;
- pInfo->cTime = statbuf.st_ctime;
-
- pInfo->mode = statbuf.st_mode;
- pInfo->links = statbuf.st_nlink;
- pInfo->major_device = statbuf.st_dev;
- pInfo->inode = statbuf.st_ino;
- pInfo->uid = statbuf.st_uid;
- pInfo->gid = statbuf.st_gid;
-
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name)
-{
- /*
- * On some systems chown will always fail for a non-root user unless
- * POSIX_CHOWN_RESTRICTED is not set. Others will succeed as long as
- * you don't try to chown a file to someone besides youself.
- */
- if (pInfo->mode != -1) {
- mode_t newMode = pInfo->mode & (S_ISUID | S_ISGID |
- S_IRWXU | S_IRWXG | S_IRWXO);
- if (chmod(name, newMode)) {
- newMode &= ~(S_ISUID | S_ISGID);
- if (chmod(name, newMode)) {
- return check_error(-1, errInfo);
- }
- }
- }
-
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_write(Efile_error* errInfo, /* Where to return error codes. */
- int flags, /* Flags given when file was
- opened. */
- int fd, /* File descriptor to write to. */
- char* buf, /* Buffer to write. */
- size_t count) /* Number of bytes to write. */
-{
- ssize_t written; /* Bytes written in last operation. */
- struct fd_data *fd_data;
-
- if ((fd_data = l_find_local_fd(fd)) != NULL) {
- if (L_FD_IS_VALID(fd_data)) {
- /* we are beyond eof and need to pad*/
- if (l_pad_file(fd_data, L_FD_CUR(fd_data)) < 0) {
- return check_error(-1, errInfo);
- }
- }
- }
-
- while (count > 0) {
- if ((written = write(fd, buf, count)) < 0) {
- if (errno != EINTR) {
- return check_error(-1, errInfo);
- }
- else {
- written = 0;
- }
- }
- ASSERT(written <= count);
- buf += written;
- count -= written;
- }
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_writev(Efile_error* errInfo, /* Where to return error codes */
- int flags, /* Flags given when file was
- * opened */
- int fd, /* File descriptor to write to */
- SysIOVec* iov, /* Vector of buffer structs.
- * The structs may be changed i.e.
- * due to incomplete writes */
- int iovcnt) /* Number of structs in vector */
-{
- struct fd_data *fd_data;
- int cnt = 0; /* Buffers so far written */
-
- ASSERT(iovcnt >= 0);
- if ((fd_data = l_find_local_fd(fd)) != NULL) {
- if (L_FD_IS_VALID(fd_data)) {
- /* we are beyond eof and need to pad*/
- if (l_pad_file(fd_data, L_FD_CUR(fd_data)) < 0) {
- return check_error(-1, errInfo);
- }
- }
- }
- while (cnt < iovcnt) {
- if ((! iov[cnt].iov_base) || (iov[cnt].iov_len <= 0)) {
- /* Empty buffer - skip */
- cnt++;
- }
- else { /* Non-empty buffer */
- ssize_t w; /* Bytes written in this call */
- do {
- w = write(fd, iov[cnt].iov_base, iov[cnt].iov_len);
- } while (w < 0 && errno == EINTR);
-
- ASSERT(w <= iov[cnt].iov_len || w == -1);
-
- if (w < 0) {
- return check_error(-1, errInfo);
- }
- /* Move forward to next buffer to write */
- for (; cnt < iovcnt && w > 0; cnt++) {
- if (iov[cnt].iov_base && iov[cnt].iov_len > 0) {
- if (w < iov[cnt].iov_len) {
- /* Adjust the buffer for next write */
- iov[cnt].iov_len -= w;
- iov[cnt].iov_base += w;
- w = 0;
- break;
- }
- else {
- w -= iov[cnt].iov_len;
- }
- }
- }
- ASSERT(w == 0);
- } /* else Non-empty buffer */
- } /* while (cnt< iovcnt) */
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_read(Efile_error* errInfo, /* Where to return error codes. */
- int flags, /* Flags given when file was opened. */
- int fd, /* File descriptor to read from. */
- char* buf, /* Buffer to read into. */
- size_t count, /* Number of bytes to read. */
- size_t *pBytesRead) /* Where to return number of
- bytes read. */
-{
- ssize_t n;
- struct fd_data *fd_data;
-
- if ((fd_data = l_find_local_fd(fd)) != NULL) {
- if (L_FD_IS_VALID(fd_data)) {
- *pBytesRead = 0;
- return 1;
- }
- }
- for (;;) {
- if ((n = read(fd, buf, count)) >= 0) {
- break;
- }
- else if (errno != EINTR) {
- return check_error(-1, errInfo);
- }
- }
- if (fd_data != NULL && L_FD_IS_VALID(fd_data)) {
- L_FD_INVALIDATE(fd_data);
- }
- *pBytesRead = (size_t) n;
- return 1;
-}
-
-/* pread() and pwrite() */
-/* Some unix systems, notably Solaris has these syscalls */
-/* It is especially nice for i.e. the dets module to have support */
-/* for this, even if the underlying OS dosn't support it, it is */
-/* reasonably easy to work around by first calling seek, and then */
-/* calling read(). */
-/* This later strategy however changes the file pointer, which pread() */
-/* does not do. We choose to ignore this and say that the location */
-/* of the file pointer is undefined after a call to any of the p functions*/
-
-
-int
-efile_pread(Efile_error* errInfo, /* Where to return error codes. */
- int fd, /* File descriptor to read from. */
- Sint64 offset, /* Offset in bytes from BOF. */
- char* buf, /* Buffer to read into. */
- size_t count, /* Number of bytes to read. */
- size_t *pBytesRead) /* Where to return
- number of bytes read. */
-{
- int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL);
- if (res) {
- return efile_read(errInfo, 0, fd, buf, count, pBytesRead);
- } else {
- return res;
- }
-}
-
-
-/***************************************************************************/
-
-int
-efile_pwrite(Efile_error* errInfo, /* Where to return error codes. */
- int fd, /* File descriptor to write to. */
- char* buf, /* Buffer to write. */
- size_t count, /* Number of bytes to write. */
- Sint64 offset) /* where to write it */
-{
- int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL);
-
- if (res) {
- return efile_write(errInfo, 0, fd, buf, count);
- } else {
- return res;
- }
-}
-
-/***************************************************************************/
-
-int
-efile_seek(Efile_error* errInfo, /* Where to return error codes. */
- int fd, /* File descriptor to do the seek on. */
- Sint64 offset, /* Offset in bytes from the given
- origin. */
- int origin, /* Origin of seek (SEEK_SET, SEEK_CUR,
- SEEK_END). */
- Sint64 *new_location) /* Resulting new location in file. */
-{
- off_t off, result;
- off = (off_t) offset;
-
- switch (origin) {
- case EFILE_SEEK_SET:
- origin = SEEK_SET;
- break;
- case EFILE_SEEK_CUR:
- origin = SEEK_CUR;
- break;
- case EFILE_SEEK_END:
- origin = SEEK_END;
- break;
- default:
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
- if (off != offset) {
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
- errno = 0;
- result = lseek(fd, off, origin);
-
- if (result >= 0) {
- l_invalidate_local_fd(fd);
- }
-
- if (result < 0)
- {
- if (errno == ENOSYS) {
- int size, cur_pos;
-
- if (off < 0) {
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
- cur_pos = lseek(fd, 0, SEEK_CUR);
- size = lseek(fd, 0, SEEK_END);
-
- if (origin == SEEK_SET) {
- result = offset;
- }
- else if (origin == SEEK_CUR) {
- result = offset + cur_pos;
- }
- else if (origin == SEEK_END) {
- result = size + offset;
- }
-
- /* sanity check our result */
- if (size > result) {
- return check_error(-1, errInfo);
- }
-
- /* store the data localy */
- l_update_local_fd(fd, result, size);
-
- /* reset the original file position */
- if (origin != SEEK_END) {
- lseek(fd, cur_pos, SEEK_SET);
- }
- }
- else if (errno == 0) {
- errno = EINVAL;
- }
- }
-
- if (new_location) {
- *new_location = result;
- }
-
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_truncate_file(Efile_error* errInfo, int *fd, int flags)
-{
- off_t offset;
- struct fd_data *fd_data;
-
- if ((fd_data = l_find_local_fd(*fd)) != NULL && L_FD_IS_VALID(fd_data)) {
- offset = L_FD_CUR(fd_data);
- }
- else {
- offset = lseek(*fd, 0, SEEK_CUR);
- }
-
- return check_error(((offset >= 0) &&
- (ftruncate(*fd, offset) == 0)) ? 1 : -1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size)
-{
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_altname(Efile_error* errInfo, char* name, char* buffer, size_t size)
-{
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_link(Efile_error* errInfo, char* old, char* new)
-{
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_symlink(Efile_error* errInfo, char* old, char* new)
-{
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset,
- Sint64 length, int advise)
-{
- return check_error(posix_fadvise(fd, offset, length, advise), errInfo);
-}
-
-/***************************************************************************/
-
-static int
-call_posix_fallocate(int fd, Sint64 offset, Sint64 length)
-{
- int ret;
-
- /*
- * On Linux and Solaris for example, posix_fallocate() returns
- * a positive error number on error and it does not set errno.
- * On FreeBSD however (9.0 at least), it returns -1 on error
- * and it sets errno.
- */
- do {
- ret = posix_fallocate(fd, (off_t) offset, (off_t) length);
- if (ret > 0) {
- errno = ret;
- ret = -1;
- }
- } while (ret != 0 && errno == EINTR);
-
- return ret;
-}
-
-/***************************************************************************/
-
-int
-efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length)
-{
- return check_error(call_posix_fallocate(fd, offset, length), errInfo);
-}
diff --git a/erts/emulator/drivers/ose/ose_signal_drv.c b/erts/emulator/drivers/ose/ose_signal_drv.c
deleted file mode 100644
index 2be9462a47..0000000000
--- a/erts/emulator/drivers/ose/ose_signal_drv.c
+++ /dev/null
@@ -1,897 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "errno.h"
-#include "stdio.h"
-#include "string.h"
-#include "stddef.h"
-
-#include "sys.h"
-#include "erl_driver.h"
-#include "ose.h"
-
-
-#ifdef HAVE_OSE_SPI_H
-#include "ose_spi/ose_spi.h"
-#endif
-
-#define DEBUG_ATTACH 0
-#define DEBUG_HUNT 0
-#define DEBUG_SEND 0
-#define DEBUG_LISTEN 0
-
-#if 0
-#define DEBUGP(FMT,...) printf(FMT, __VA_ARGS__)
-#else
-#define DEBUGP(FMT,...)
-#endif
-
-#if DEBUG_ATTACH
-#define DEBUGP_ATTACH(...) DEBUGP( __VA_ARGS__)
-#else
-#define DEBUGP_ATTACH(...)
-#endif
-
-#if DEBUG_HUNT
-#define DEBUGP_HUNT(...) DEBUGP( __VA_ARGS__)
-#else
-#define DEBUGP_HUNT(...)
-#endif
-
-#if DEBUG_LISTEN
-#define DEBUGP_LISTEN(...) DEBUGP( __VA_ARGS__)
-#else
-#define DEBUGP_LISTEN(...)
-#endif
-
-#if DEBUG_SEND
-#define DEBUGP_SEND(...) DEBUGP( __VA_ARGS__)
-#else
-#define DEBUGP_SEND(...)
-#endif
-
-
-#define DRIVER_NAME "ose_signal_drv"
-#define GET_SPID 1
-#define GET_NAME 2
-#define HUNT 100
-#define DEHUNT 101
-#define ATTACH 102
-#define DETACH 103
-#define SEND 104
-#define SEND_W_S 105
-#define LISTEN 106
-#define OPEN 200
-
-#define REF_SEGMENT_SIZE 8
-
-struct async {
- SIGSELECT signo;
- ErlDrvTermData port;
- ErlDrvTermData proc;
- PROCESS spid;
- PROCESS target;
- Uint32 ref;
-};
-
-/**
- * OSE signals
- **/
-union SIGNAL {
- SIGSELECT signo;
- struct async async;
-};
-
-/**
- * The driver's context
- **/
-typedef struct _driver_context {
- ErlDrvPort port;
- PROCESS spid;
- ErlDrvEvent perm_events[2];
- ErlDrvEvent *events;
- Uint32 event_cnt;
- Uint32 ref;
- Uint32 *outstanding_refs;
- Uint32 outstanding_refs_max;
- Uint32 outstanding_refs_cnt;
-} driver_context_t;
-
-/**
- * Global variables
- **/
-static ErlDrvTermData a_ok;
-static ErlDrvTermData a_error;
-static ErlDrvTermData a_enomem;
-static ErlDrvTermData a_enoent;
-static ErlDrvTermData a_badarg;
-static ErlDrvTermData a_mailbox_up;
-static ErlDrvTermData a_mailbox_down;
-static ErlDrvTermData a_ose_drv_reply;
-static ErlDrvTermData a_message;
-static PROCESS proxy_proc;
-
-
-/**
- * Serialize/unserialize unsigned 32-bit values
- **/
-static char *put_u32(unsigned int value, char *ptr) {
- *ptr++ = (value & 0xff000000) >> 24;
- *ptr++ = (value & 0x00ff0000) >> 16;
- *ptr++ = (value & 0x0000ff00) >> 8;
- *ptr++ = (value & 0xff);
-
- return ptr;
-}
-
-static unsigned int get_u32(char *ptr) {
- unsigned int result = 0;
- result += (ptr[0] & 0xff) << 24;
- result += (ptr[1] & 0xff) << 16;
- result += (ptr[2] & 0xff) << 8;
- result += (ptr[3] & 0xff);
-
- return result;
-}
-
-
-/* Stolen from efile_drv.c */
-
-/* char EV_CHAR_P(ErlIOVec *ev, int p, int q) */
-#define EV_CHAR_P(ev, p, q) \
- (((char *)(ev)->iov[(q)].iov_base) + (p))
-
-/* int EV_GET_CHAR(ErlIOVec *ev, char *p, int *pp, int *qp) */
-#define EV_GET_CHAR(ev, p, pp, qp) ev_get_char(ev, p ,pp, qp)
-static int
-ev_get_char(ErlIOVec *ev, char *p, int *pp, int *qp) {
- if (*(pp)+1 <= (ev)->iov[*(qp)].iov_len) {
- *(p) = *EV_CHAR_P(ev, *(pp), *(qp));
- if (*(pp)+1 < (ev)->iov[*(qp)].iov_len)
- *(pp) = *(pp)+1;
- else {
- (*(qp))++;
- *pp = 0;
- }
- return !0;
- }
- return 0;
-}
-
-/* Uint32 EV_UINT32(ErlIOVec *ev, int p, int q)*/
-#define EV_UINT32(ev, p, q) \
- ((Uint32) *(((unsigned char *)(ev)->iov[(q)].iov_base) + (p)))
-
-/* int EV_GET_UINT32(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) */
-#define EV_GET_UINT32(ev, p, pp, qp) ev_get_uint32(ev,(Uint32*)(p),pp,qp)
-static int
-ev_get_uint32(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) {
- if (*(pp)+4 <= (ev)->iov[*(qp)].iov_len) {
- *(p) = (EV_UINT32(ev, *(pp), *(qp)) << 24)
- | (EV_UINT32(ev, *(pp)+1, *(qp)) << 16)
- | (EV_UINT32(ev, *(pp)+2, *(qp)) << 8)
- | (EV_UINT32(ev, *(pp)+3, *(qp)));
- if (*(pp)+4 < (ev)->iov[*(qp)].iov_len)
- *(pp) = *(pp)+4;
- else {
- (*(qp))++;
- *pp = 0;
- }
- return !0;
- }
- return 0;
-}
-
-/**
- * Convinience macros
- **/
-#define send_response(port,output) erl_drv_send_term(driver_mk_port(port),\
- driver_caller(port), output, sizeof(output) / sizeof(output[0]));
-
-void iov_memcpy(void *dest,ErlIOVec *ev,int ind,int off);
-void iov_memcpy(void *dest,ErlIOVec *ev,int ind,int off) {
- int i;
- memcpy(dest,ev->iov[ind].iov_base+off,ev->iov[ind].iov_len-off);
- for (i = ind+1; i < ev->vsize; i++)
- memcpy(dest,ev->iov[i].iov_base,ev->iov[i].iov_len);
-}
-
-/**
- * Reference handling
- **/
-
-static int add_reference(driver_context_t *ctxt, Uint32 ref) {
-
- /*
- * Premature optimizations may be evil, but they sure are fun.
- */
-
- if (ctxt->outstanding_refs == NULL) {
- /* First ref to be ignored */
- ctxt->outstanding_refs = driver_alloc(REF_SEGMENT_SIZE*sizeof(Uint32));
- if (!ctxt->outstanding_refs)
- return 1;
-
- memset(ctxt->outstanding_refs,0,REF_SEGMENT_SIZE*sizeof(Uint32));
- ctxt->outstanding_refs_max += REF_SEGMENT_SIZE;
- ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref;
- } else if (ctxt->outstanding_refs_cnt == ctxt->outstanding_refs_max) {
- /* Expand ref array */
- Uint32 *new_array;
- ctxt->outstanding_refs_max += REF_SEGMENT_SIZE;
- new_array = driver_realloc(ctxt->outstanding_refs,
- ctxt->outstanding_refs_max*sizeof(Uint32));
-
- if (!new_array) {
- ctxt->outstanding_refs_max -= REF_SEGMENT_SIZE;
- return 1;
- }
-
- ctxt->outstanding_refs = new_array;
-
- memset(ctxt->outstanding_refs+ctxt->outstanding_refs_cnt,0,
- REF_SEGMENT_SIZE*sizeof(Uint32));
- ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref;
-
- } else {
- /* Find an empty slot:
- * First we try current index,
- * then we scan for a slot.
- */
- if (!ctxt->outstanding_refs[ctxt->outstanding_refs_cnt]) {
- ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref;
- } else {
- int i;
- ASSERT(ctxt->outstanding_refs_cnt < ctxt->outstanding_refs_max);
- for (i = 0; i < ctxt->outstanding_refs_max; i++)
- if (!ctxt->outstanding_refs[i])
- break;
- ASSERT(ctxt->outstanding_refs[i] == 0);
- ctxt->outstanding_refs[i] = ref;
- ctxt->outstanding_refs_cnt++;
- }
- }
- return 0;
-}
-
-/* Return 0 if removed, 1 if does not exist, */
-static int remove_reference(driver_context_t *ctxt, Uint32 ref) {
- int i,j;
-
- if (ctxt->outstanding_refs_max == 0 && ctxt->outstanding_refs_cnt == 0) {
- ASSERT(ctxt->outstanding_refs == NULL);
- return 1;
- }
-
- for (i = 0; i < ctxt->outstanding_refs_max; i++) {
- if (ctxt->outstanding_refs[i] == ref) {
- ctxt->outstanding_refs[i] = 0;
- ctxt->outstanding_refs_cnt--;
- i = -1;
- break;
- }
- }
-
- if (i != -1)
- return 1;
-
- if (ctxt->outstanding_refs_cnt == 0) {
- driver_free(ctxt->outstanding_refs);
- ctxt->outstanding_refs = NULL;
- ctxt->outstanding_refs_max = 0;
- } else if (ctxt->outstanding_refs_cnt == (ctxt->outstanding_refs_max - REF_SEGMENT_SIZE)) {
- Uint32 *new_array;
- for (i = 0, j = 0; i < ctxt->outstanding_refs_cnt; i++) {
- if (ctxt->outstanding_refs[i] == 0) {
- for (j = i+1; j < ctxt->outstanding_refs_max; j++)
- if (ctxt->outstanding_refs[j]) {
- ctxt->outstanding_refs[i] = ctxt->outstanding_refs[j];
- ctxt->outstanding_refs[j] = 0;
- break;
- }
- }
- }
- ctxt->outstanding_refs_max -= REF_SEGMENT_SIZE;
- new_array = driver_realloc(ctxt->outstanding_refs,
- ctxt->outstanding_refs_max*sizeof(Uint32));
- if (!new_array) {
- ctxt->outstanding_refs_max += REF_SEGMENT_SIZE;
- return 2;
- }
-
- ctxt->outstanding_refs = new_array;
-
- }
-
- return 0;
-}
-
-/**
- * The OSE proxy process. This only handles ERTS_SIGNAL_OSE_DRV_ATTACH.
- * The process is needed because signals triggered by attach ignore
- * redir tables.
- *
- * We have one global proxy process to save memory. An attempt to make each
- * port phantom into a proxy was made, but that used way to much memory.
- */
-static OS_PROCESS(driver_proxy_process) {
- SIGSELECT sigs[] = {1,ERTS_SIGNAL_OSE_DRV_ATTACH};
- PROCESS master = 0;
-
- while (1) {
- union SIGNAL *sig = receive(sigs);
-
- if (sig->signo == ERTS_SIGNAL_OSE_DRV_ATTACH) {
-
- /* The first message is used to determine who to send messages to. */
- if (master == 0)
- master = sender(&sig);
-
- if (sig->async.target == 0) {
- PROCESS from = sender(&sig);
- restore(sig);
- DEBUGP_ATTACH("0x%x: got attach 0x%x, sending to 0x%x\n",
- current_process(),from,master);
- sig->async.target = from;
- send(&sig,master);
- } else {
- PROCESS target = sig->async.target;
- restore(sig);
- sig->async.target = 0;
- DEBUGP_ATTACH("0x%x: doing attach on 0x%x\n",current_process(),target);
- attach(&sig,target);
- }
- }
- }
-}
-
-
-/**
- * Init routine for the driver
- **/
-static int drv_init(void) {
-
- a_ok = driver_mk_atom("ok");
- a_error = driver_mk_atom("error");
- a_enomem = driver_mk_atom("enomem");
- a_enoent = driver_mk_atom("enoent");
- a_badarg = driver_mk_atom("badarg");
- a_mailbox_up = driver_mk_atom("mailbox_up");
- a_mailbox_down = driver_mk_atom("mailbox_down");
- a_ose_drv_reply = driver_mk_atom("ose_drv_reply");
- a_message = driver_mk_atom("message");
-
- proxy_proc = create_process(get_ptype(current_process()),
- "ose_signal_driver_proxy",
- driver_proxy_process, 10000,
- get_pri(current_process()),
- 0, 0, NULL, 0, 0);
-
-#ifdef DEBUG
- efs_clone(proxy_proc);
-#endif
- start(proxy_proc);
-
- return 0;
-}
-
-/* Signal resolution callback */
-static ErlDrvOseEventId resolve_signal(union SIGNAL* osig) {
- union SIGNAL *sig = osig;
- if (sig->signo == ERTS_SIGNAL_OSE_DRV_HUNT ||
- sig->signo == ERTS_SIGNAL_OSE_DRV_ATTACH) {
- return sig->async.spid;
- }
- DEBUGP("%p: Got signal %d sent to %p from 0x%p\n",
- current_process(),sig->signo,addressee(&sig),sender(&sig));
- return addressee(&sig);
-}
-
-
-/**
- * Start routine for the driver
- **/
-static ErlDrvData drv_start(ErlDrvPort port, char *command)
-{
- driver_context_t *ctxt = driver_alloc(sizeof(driver_context_t));
-
- ctxt->perm_events[0] = NULL;
- ctxt->perm_events[1] = NULL;
-
- ctxt->spid = 0;
- ctxt->port = port;
- ctxt->event_cnt = 0;
- ctxt->events = NULL;
- ctxt->ref = 0;
- ctxt->outstanding_refs = NULL;
- ctxt->outstanding_refs_max = 0;
- ctxt->outstanding_refs_cnt = 0;
-
-
- /* Set the communication protocol to Erlang to be binary */
- set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY);
-
- /* Everything ok */
- return (ErlDrvData)ctxt;
-}
-
-/**
- * Stop routine for the driver
- **/
-static void drv_stop(ErlDrvData driver_data)
-{
- driver_context_t *ctxt = (driver_context_t *)driver_data;
- int i;
-
- /* HUNT + ATTACH */
- if (ctxt->perm_events[0])
- driver_select(ctxt->port, ctxt->perm_events[0],
- ERL_DRV_USE|ERL_DRV_READ, 0);
- if (ctxt->perm_events[1])
- driver_select(ctxt->port, ctxt->perm_events[1],
- ERL_DRV_USE|ERL_DRV_READ, 0);
-
- for (i = 0; i < ctxt->event_cnt; i++) {
- driver_select(ctxt->port, ctxt->events[i], ERL_DRV_USE|ERL_DRV_READ, 0);
- }
-
- if (ctxt->spid != 0)
- kill_proc(ctxt->spid);
- DEBUGP("0x%x: stopped\n",ctxt->spid);
- if (ctxt->events)
- driver_free(ctxt->events);
- if (ctxt->outstanding_refs)
- driver_free(ctxt->outstanding_refs);
-
- driver_free(ctxt);
-}
-
-/**
- * Output from Erlang
- **/
-static void outputv(ErlDrvData driver_data, ErlIOVec *ev)
-{
- driver_context_t *ctxt = (driver_context_t *)driver_data;
- int p = 0, q = 1;
- char cmd;
-
- if (! EV_GET_CHAR(ev,&cmd,&p,&q)) {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_badarg,
- ERL_DRV_TUPLE, 3};
- send_response(ctxt->port, output);
- return;
- }
-
- /* Command is in the buffer's first byte */
- switch(cmd) {
-
- case OPEN: {
- char *name = driver_alloc(ev->size - 1+1);
- struct OS_redir_entry redir[2];
-
- redir[0].sig = 1;
- redir[0].pid = current_process();
-
- iov_memcpy(name,ev,q,p);
- name[ev->size-1] = '\0';
-
- ctxt->spid = create_process(OS_PHANTOM, name, NULL, 0,
- 0, 0, 0, redir, 0, 0);
-
- DEBUGP("0x%x: open\n",ctxt->spid);
-
- ctxt->perm_events[1] =
- erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_ATTACH,(int)ctxt->spid,
- resolve_signal, NULL);
- driver_select(ctxt->port,ctxt->perm_events[1],ERL_DRV_READ|ERL_DRV_USE,1);
-
- ctxt->perm_events[0] =
- erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_HUNT,(int)ctxt->spid,
- resolve_signal, NULL);
- driver_select(ctxt->port,ctxt->perm_events[0],ERL_DRV_READ|ERL_DRV_USE,1);
-
- start(ctxt->spid);
-
- {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_ok,
- ERL_DRV_TUPLE, 3};
-
- send_response(ctxt->port, output);
- }
-
- break;
-
- }
-
- case ATTACH:
- case HUNT:
- {
- union SIGNAL *sig = alloc(sizeof(union SIGNAL),
- cmd == HUNT ? ERTS_SIGNAL_OSE_DRV_HUNT:ERTS_SIGNAL_OSE_DRV_ATTACH);
-
- sig->async.port = driver_mk_port(ctxt->port);
- sig->async.proc = driver_caller(ctxt->port);
- sig->async.spid = ctxt->spid;
- sig->async.ref = ++ctxt->ref;
-
- if (add_reference(ctxt,ctxt->ref)) {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_enomem,
- ERL_DRV_TUPLE, 3};
- send_response(ctxt->port, output);
- free_buf(&sig);
- } else {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_INT, (ErlDrvUInt)ctxt->ref,
- ERL_DRV_TUPLE, 2,
- ERL_DRV_TUPLE, 3};
- send_response(ctxt->port, output);
-
- if (cmd == HUNT) {
- char *huntname = driver_alloc(sizeof(char)*((ev->size-1)+1));
-
- iov_memcpy(huntname,ev,q,p);
- huntname[ev->size-1] = '\0';
-
- DEBUGP_HUNT("0x%x: hunt %s -> %u (%u,%u)\n",
- ctxt->spid,huntname,ctxt->ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
-
- hunt(huntname, 0, NULL, &sig);
-
- driver_free(huntname);
- } else {
- EV_GET_UINT32(ev,&sig->async.target,&p,&q);
- DEBUGP_ATTACH("0x%x: attach %u -> %u (%u,%u)\n",
- ctxt->spid,sig->async.target,
- ctxt->ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
-
- send(&sig,proxy_proc);
- }
-
- }
-
- break;
- }
-
- case DETACH:
- case DEHUNT:
- {
-
- Uint32 ref;
-
- EV_GET_UINT32(ev,&ref,&p,&q);
- if (cmd == DETACH) {
- DEBUGP_ATTACH("0x%x: detach %u (%u,%u)\n",ctxt->spid,ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- } else {
- DEBUGP_HUNT("0x%x: dehunt %u (%u,%u)\n",ctxt->spid,ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- }
-
- if (remove_reference(ctxt,ref)) {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_error,
- ERL_DRV_ATOM, a_enoent,
- ERL_DRV_TUPLE, 2,
- ERL_DRV_TUPLE, 3};
-
- send_response(ctxt->port, output);
- } else {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_ok,
- ERL_DRV_TUPLE, 3};
-
- send_response(ctxt->port, output);
- }
-
- break;
- }
-
- case SEND:
- case SEND_W_S:
- {
- PROCESS spid;
- PROCESS sender;
- SIGSELECT signo;
- OSBUFSIZE size = ev->size-9;
- union SIGNAL *sig;
-
- EV_GET_UINT32(ev,&spid,&p,&q);
-
- if (cmd == SEND_W_S) {
- EV_GET_UINT32(ev,&sender,&p,&q);
- size -= 4;
- } else {
- sender = ctxt->spid;
- }
-
- EV_GET_UINT32(ev,&signo,&p,&q);
-
- sig = alloc(size + sizeof(SIGSELECT),signo);
-
- if (cmd == SEND_W_S) {
- DEBUGP_SEND("0x%x: send_w_s(%u,%u,%u)\n",ctxt->spid,spid,signo,sender);
- } else {
- DEBUGP_SEND("0x%x: send(%u,%u)\n",ctxt->spid,spid,signo);
- }
-
- iov_memcpy(((char *)&sig->signo) + sizeof(SIGSELECT),ev,q,p);
-
- send_w_s(&sig, sender, spid);
-
- break;
- }
-
- case LISTEN:
- {
- int i,j,event_cnt = (ev->size - 1)/4;
- ErlDrvEvent *events = NULL;
- SIGSELECT signo,tmp_signo;
-
- if (event_cnt == 0) {
- for (i = 0; i < ctxt->event_cnt; i++)
- driver_select(ctxt->port,ctxt->events[i],ERL_DRV_READ|ERL_DRV_USE,0);
- if (ctxt->events)
- driver_free(ctxt->events);
- } else {
- events = driver_alloc(sizeof(ErlDrvEvent)*event_cnt);
- EV_GET_UINT32(ev,&signo,&p,&q);
- for (i = 0, j = 0; i < event_cnt || j < ctxt->event_cnt; ) {
-
- if (ctxt->events)
- erl_drv_ose_event_fetch(ctxt->events[j],&tmp_signo,NULL,NULL);
-
- if (signo == tmp_signo) {
- events[i++] = ctxt->events[j++];
- EV_GET_UINT32(ev,&signo,&p,&q);
- } else if (signo < tmp_signo || !ctxt->events) {
- /* New signal to select on */
- events[i] = erl_drv_ose_event_alloc(signo,(int)ctxt->spid,
- resolve_signal, NULL);
- driver_select(ctxt->port,events[i++],ERL_DRV_READ|ERL_DRV_USE,1);
- EV_GET_UINT32(ev,&signo,&p,&q);
- } else {
- /* Remove old signal to select on */
- driver_select(ctxt->port,ctxt->events[j++],ERL_DRV_READ|ERL_DRV_USE,0);
- }
- }
- if (ctxt->events)
- driver_free(ctxt->events);
- }
- ctxt->events = events;
- ctxt->event_cnt = event_cnt;
-
- {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_ok,
- ERL_DRV_TUPLE, 3};
- send_response(ctxt->port, output);
- }
- break;
- }
-
- default:
- {
- DEBUGP("Warning: 'ose_signal_drv' unknown command '%d'\n", cmd);
- break;
- }
- }
-}
-
-/**
- * Handler for when OSE signal arrives
- **/
-static void ready_input(ErlDrvData driver_data, ErlDrvEvent event)
-{
- driver_context_t *ctxt = (driver_context_t *)driver_data;
- union SIGNAL *sig = erl_drv_ose_get_signal(event);
-
- while (sig != NULL) {
-
- switch(sig->signo)
- {
- /* Remote process is available */
- case ERTS_SIGNAL_OSE_DRV_HUNT:
- {
- const PROCESS spid = sender(&sig);
-
- if (remove_reference(ctxt,sig->async.ref)) {
- DEBUGP_HUNT("0x%x: Got hunt from 0x%x -> %u (CANCELLED) (%u,%u)\n",
- ctxt->spid,spid,sig->async.ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- /* Already removed by dehunt */
- } else {
- ErlDrvTermData reply[] = {
- ERL_DRV_ATOM, a_mailbox_up,
- ERL_DRV_PORT, sig->async.port,
- ERL_DRV_PORT, sig->async.port,
- ERL_DRV_UINT, (ErlDrvUInt)sig->async.ref,
- ERL_DRV_TUPLE, 2,
- ERL_DRV_UINT, (ErlDrvUInt)spid,
- ERL_DRV_TUPLE, 4};
- DEBUGP_HUNT("0x%x: Got hunt from 0x%x -> %u (%u,%u)\n",
- ctxt->spid,spid,sig->async.ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- erl_drv_send_term(sig->async.port, sig->async.proc, reply,
- sizeof(reply) / sizeof(reply[0]));
- }
- break;
- }
-
- /* Remote process is down */
- case ERTS_SIGNAL_OSE_DRV_ATTACH:
- {
- PROCESS spid = sig->async.target;
-
- if (remove_reference(ctxt,sig->async.ref)) {
- DEBUGP_ATTACH("0x%x: Got attach from 0x%x -> %u (CANCELLED) (%u,%u)\n",
- ctxt->spid,spid,sig->async.ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- /* Already removed by detach */
- } else {
- ErlDrvTermData reply[] = {
- ERL_DRV_ATOM, a_mailbox_down,
- ERL_DRV_PORT, sig->async.port,
- ERL_DRV_PORT, sig->async.port,
- ERL_DRV_UINT, sig->async.ref,
- ERL_DRV_TUPLE, 2,
- ERL_DRV_UINT, (ErlDrvUInt)spid,
- ERL_DRV_TUPLE, 4};
- DEBUGP_ATTACH("0x%x: Got attach from 0x%x -> %u (%u,%u)\n",
- ctxt->spid,spid,sig->async.ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- erl_drv_send_term(sig->async.port, sig->async.proc, reply,
- sizeof(reply) / sizeof(reply[0]));
- }
- break;
- }
-
- /* Received user defined signal */
- default:
- {
- const PROCESS spid = sender(&sig);
- const OSBUFSIZE size = sigsize(&sig) - sizeof(SIGSELECT);
- const char *sig_data = ((char *)&sig->signo) + sizeof(SIGSELECT);
-
- ErlDrvTermData reply[] = {
- ERL_DRV_ATOM, a_message,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_UINT, (ErlDrvUInt)spid,
- ERL_DRV_UINT, (ErlDrvUInt)ctxt->spid,
- ERL_DRV_UINT, (ErlDrvUInt)sig->signo,
- ERL_DRV_BUF2BINARY, (ErlDrvTermData)sig_data, (ErlDrvUInt)size,
- ERL_DRV_TUPLE, 4,
- ERL_DRV_TUPLE, 3};
-
- DEBUGP_SEND("0x%x: Got 0x%u\r\n", spid, sig->signo);
-
- erl_drv_output_term(driver_mk_port(ctxt->port), reply,
- sizeof(reply) / sizeof(reply[0]));
- break;
- }
- }
-
- free_buf(&sig);
- sig = erl_drv_ose_get_signal(event);
- }
-}
-
-/**
- * Handler for 'port_control'
- **/
-static ErlDrvSSizeT control(ErlDrvData driver_data, unsigned int cmd,
- char *buf, ErlDrvSizeT len,
- char **rbuf, ErlDrvSizeT rlen)
-{
- driver_context_t *ctxt = (driver_context_t *)driver_data;
-
- switch(cmd)
- {
- case GET_SPID:
- {
- const PROCESS spid = ctxt->spid;
- put_u32(spid, *rbuf);
- return sizeof(PROCESS);
- }
-
-#ifdef HAVE_OSE_SPI_H
- case GET_NAME:
- {
- const PROCESS spid = get_u32(buf);
- char *name = (char*)get_pid_info(spid,OSE_PI_NAME);
- int n;
- if (!name) {
- *rbuf = NULL;
- return 0;
- }
-
- if (rlen < (n = strlen(name))) {
- ErlDrvBinary *bin = driver_alloc_binary(n);
- strncpy(bin->orig_bytes,name,n);
- *rbuf = (char*)bin;
- } else
- strncpy(*rbuf,name,n);
- free_buf((union SIGNAL**)&name);
-
- return n;
- }
-#endif
- default:
- {
- /* Unknown command */
- return (ErlDrvSSizeT)ERL_DRV_ERROR_GENERAL;
- break;
- }
- }
-}
-
-static void stop_select(ErlDrvEvent event, void *reserved)
-{
- erl_drv_ose_event_free(event);
-}
-
-/**
- * Setup the driver entry for the Erlang runtime
- **/
-ErlDrvEntry ose_signal_driver_entry = {
- .init = drv_init,
- .start = drv_start,
- .stop = drv_stop,
- .outputv = outputv,
- .ready_input = ready_input,
- .driver_name = DRIVER_NAME,
- .control = control,
- .extended_marker = ERL_DRV_EXTENDED_MARKER,
- .major_version = ERL_DRV_EXTENDED_MAJOR_VERSION,
- .minor_version = ERL_DRV_EXTENDED_MINOR_VERSION,
- .driver_flags = ERL_DRV_FLAG_USE_PORT_LOCKING,
- .stop_select = stop_select
-};
-
diff --git a/erts/emulator/drivers/ose/ttsl_drv.c b/erts/emulator/drivers/ose/ttsl_drv.c
deleted file mode 100644
index f759b47984..0000000000
--- a/erts/emulator/drivers/ose/ttsl_drv.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Stub tty driver because group/user depend on this.
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "erl_driver.h"
-
-static int ttysl_init(void);
-static ErlDrvData ttysl_start(ErlDrvPort, char*);
-
-/* Define the driver table entry. */
-struct erl_drv_entry ttsl_driver_entry = {
- ttysl_init,
- ttysl_start,
- NULL,
- NULL,
- NULL,
- NULL,
- "tty_sl",
- NULL,
- NULL,
- NULL,
- NULL, /* timeout */
- NULL, /* outputv */
- NULL, /* ready_async */
- NULL, /* flush */
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0, /* ERL_DRV_FLAGs */
- NULL,
- NULL, /* process_exit */
- NULL
-};
-
-
-static int ttysl_init(void)
-{
- return 0;
-}
-
-static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
-{
- return ERL_DRV_ERROR_GENERAL;
-}
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index cc68e1f74d..6f495b8825 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -488,7 +488,7 @@ static void *const_term_alloc(void *tmpl)
alloc_size = size + (offsetof(struct const_term, mem)/sizeof(Eterm));
hipe_constants_size += alloc_size;
- p = (struct const_term*)erts_alloc(ERTS_ALC_T_HIPE, alloc_size * sizeof(Eterm));
+ p = (struct const_term*)erts_alloc(ERTS_ALC_T_LITERAL, alloc_size * sizeof(Eterm));
/* I have absolutely no idea if having a private 'off_heap'
works or not. _Some_ off_heap object is required for
@@ -497,6 +497,8 @@ static void *const_term_alloc(void *tmpl)
hp = &p->mem[0];
p->val = copy_struct(obj, size, &hp, &const_term_table_off_heap);
+ erts_set_literal_tag(&p->val, &p->mem[0], size);
+
return &p->bucket;
}
@@ -507,6 +509,9 @@ static void init_const_term_table(void)
f.cmp = (HCMP_FUN) const_term_cmp;
f.alloc = (HALLOC_FUN) const_term_alloc;
f.free = (HFREE_FUN) NULL;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_HIPE, &const_term_table, "const_term_table", 97, f);
}
@@ -574,15 +579,15 @@ static void print_mfa(Eterm mod, Eterm fun, unsigned int ari)
static Uint *hipe_find_emu_address(Eterm mod, Eterm name, unsigned int arity)
{
Module *modp;
- Uint *code_base;
+ BeamCodeHeader* code_hdr;
int i, n;
modp = erts_get_module(mod, erts_active_code_ix());
- if (modp == NULL || (code_base = modp->curr.code) == NULL)
+ if (modp == NULL || (code_hdr = modp->curr.code_hdr) == NULL)
return NULL;
- n = code_base[MI_NUM_FUNCTIONS];
+ n = code_hdr->num_functions;
for (i = 0; i < n; ++i) {
- Uint *code_ptr = (Uint*)code_base[MI_FUNCTIONS+i];
+ Uint *code_ptr = (Uint*)code_hdr->functions[i];
ASSERT(code_ptr[0] == BeamOpCode(op_i_func_info_IaaI));
if (code_ptr[3] == name && code_ptr[4] == arity)
return code_ptr+5;
@@ -715,6 +720,9 @@ static void init_nbif_table(void)
f.cmp = (HCMP_FUN) nbif_cmp;
f.alloc = (HALLOC_FUN) nbif_alloc;
f.free = NULL;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_NBIF_TABLE, &nbif_table, "nbif_table", 500, f);
@@ -808,6 +816,9 @@ static void init_primop_table(void)
f.cmp = (HCMP_FUN) primop_cmp;
f.alloc = (HALLOC_FUN) primop_alloc;
f.free = NULL;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_HIPE, &primop_table, "primop_table", 50, f);
@@ -1826,6 +1837,9 @@ static void init_modinfo_table(void)
f.cmp = (HCMP_FUN) modinfo_cmp;
f.alloc = (HALLOC_FUN) modinfo_alloc;
f.free = (HFREE_FUN) NULL;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_HIPE, &modinfo_table, "modinfo_table", 11, f);
}
diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c
index 2c747771ac..2e19bf88bf 100644
--- a/erts/emulator/hipe/hipe_gc.c
+++ b/erts/emulator/hipe/hipe_gc.c
@@ -46,10 +46,6 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
/* arch-specific nstack walk state */
struct nstack_walk_state walk_state;
- /* fullsweep-specific state */
- char *src, *oh;
- Uint src_size, oh_size;
-
if (!p->hipe.nstack) {
ASSERT(!p->hipe.nsp && !p->hipe.nstend);
return n_htop;
@@ -66,11 +62,6 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
sdesc = nstack_walk_init_sdesc(p, &walk_state);
- src = (char*)HEAP_START(p);
- src_size = (char*)HEAP_TOP(p) - src;
- oh = (char*)OLD_HEAP(p);
- oh_size = (char*)OLD_HTOP(p) - oh;
-
for (;;) {
if (nstack_walk_nsp_reached_end(nsp, nsp_end)) {
if (nsp == nsp_end) {
@@ -97,8 +88,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*nsp_i = val;
- } else if (in_area(ptr, src, src_size) ||
- in_area(ptr, oh, oh_size)) {
+ } else if (!erts_is_literal(gval, ptr)) {
MOVE_BOXED(ptr, val, n_htop, nsp_i);
}
} else if (is_list(gval)) {
@@ -106,8 +96,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
Eterm val = *ptr;
if (IS_MOVED_CONS(val)) {
*nsp_i = ptr[1];
- } else if (in_area(ptr, src, src_size) ||
- in_area(ptr, oh, oh_size)) {
+ } else if (!erts_is_literal(gval, ptr)) {
ASSERT(within(ptr, p));
MOVE_CONS(ptr, val, n_htop, nsp_i);
}
@@ -139,11 +128,13 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
unsigned int mask;
/* arch-specific nstack walk state */
struct nstack_walk_state walk_state;
+ char *oh;
+ Uint oh_size;
/* gensweep-specific state */
Eterm *old_htop, *n_htop;
- char *heap;
- Uint heap_size, mature_size;
+ char *mature;
+ Uint mature_size;
if (!p->hipe.nstack) {
ASSERT(!p->hipe.nsp && !p->hipe.nstend);
@@ -168,9 +159,10 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
old_htop = *ptr_old_htop;
n_htop = *ptr_n_htop;
- heap = (char*)HEAP_START(p);
- heap_size = (char*)HEAP_TOP(p) - heap;
- mature_size = (char*)HIGH_WATER(p) - heap;
+ mature = (char *) (p->abandoned_heap ? p->abandoned_heap : p->heap);
+ mature_size = (char*)HIGH_WATER(p) - mature;
+ oh = (char*)OLD_HEAP(p);
+ oh_size = (char*)OLD_HTOP(p) - oh;
for (;;) {
if (nstack_walk_nsp_reached_end(nsp, nsp_end)) {
@@ -209,9 +201,9 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*nsp_i = val;
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_BOXED(ptr, val, old_htop, nsp_i);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
ASSERT(within(ptr, p));
MOVE_BOXED(ptr, val, n_htop, nsp_i);
}
@@ -220,9 +212,9 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
Eterm val = *ptr;
if (IS_MOVED_CONS(val)) {
*nsp_i = ptr[1];
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_CONS(ptr, val, old_htop, nsp_i);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
ASSERT(within(ptr, p));
MOVE_CONS(ptr, val, n_htop, nsp_i);
}
diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c
index 968452a641..976180cc30 100644
--- a/erts/emulator/hipe/hipe_mode_switch.c
+++ b/erts/emulator/hipe/hipe_mode_switch.c
@@ -196,7 +196,7 @@ hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity)
ASSERT(!(p->flags & F_DISABLE_GC));
if ((p->stop - 2) < p->htop) {
DPRINTF("calling gc to increase BEAM stack size");
- p->fcalls -= erts_garbage_collect(p, 2, reg, arity);
+ erts_garbage_collect(p, 2, reg, arity);
ASSERT(!((p->stop - 2) < p->htop));
}
p->stop -= 2;
diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h
index bc863a4f36..620cc6356b 100644
--- a/erts/emulator/hipe/hipe_mode_switch.h
+++ b/erts/emulator/hipe/hipe_mode_switch.h
@@ -95,7 +95,7 @@ ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsig
/* ensure that at least 2 words are available on the BEAM stack */
if ((p->stop - 2) < p->htop) {
- p->fcalls -= erts_garbage_collect(p, 2, reg, arity);
+ erts_garbage_collect(p, 2, reg, arity);
ASSERT(!((p->stop - 2) < p->htop));
}
p->stop -= 2;
diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c
index 119b0b0895..16cc70234d 100644
--- a/erts/emulator/hipe/hipe_native_bif.c
+++ b/erts/emulator/hipe/hipe_native_bif.c
@@ -80,7 +80,7 @@ Eterm hipe_show_nstack_1(BIF_ALIST_1)
void hipe_gc(Process *p, Eterm need)
{
hipe_set_narity(p, 1);
- p->fcalls -= erts_garbage_collect(p, unsigned_val(need), NULL, 0);
+ erts_garbage_collect(p, unsigned_val(need), NULL, 0);
hipe_set_narity(p, 0);
}
@@ -157,13 +157,22 @@ BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1)
*/
void hipe_select_msg(Process *p)
{
- ErlMessage *msgp;
+ ErtsMessage *msgp;
msgp = PEEK_MESSAGE(p);
UNLINK_MESSAGE(p, msgp); /* decrements global 'erts_proc_tot_mem' variable */
JOIN_MESSAGE(p);
CANCEL_TIMER(p); /* calls erts_cancel_proc_timer() */
- free_message(msgp);
+ erts_save_message_in_proc(p, msgp);
+ p->flags &= ~F_DELAY_GC;
+ if (ERTS_IS_GC_DESIRED(p)) {
+ /*
+ * We want to GC soon but we leave a few
+ * reductions giving the message some time
+ * to turn into garbage.
+ */
+ ERTS_VBUMP_LEAVE_REDS(p, 5);
+ }
}
void hipe_fclearerror_error(Process *p)
@@ -520,8 +529,9 @@ BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2)
*/
Eterm hipe_check_get_msg(Process *c_p)
{
- Eterm ret;
- ErlMessage *msgp;
+ ErtsMessage *msgp;
+
+ c_p->flags |= F_DELAY_GC;
next_message:
@@ -543,25 +553,29 @@ Eterm hipe_check_get_msg(Process *c_p)
/* XXX: BEAM doesn't need this */
c_p->hipe_smp.have_receive_locks = 1;
#endif
+ c_p->flags &= ~F_DELAY_GC;
return THE_NON_VALUE;
#ifdef ERTS_SMP
}
#endif
}
- ErtsMoveMsgAttachmentIntoProc(msgp, c_p, c_p->stop, HEAP_TOP(c_p),
- c_p->fcalls, (void) 0, (void) 0);
- ret = ERL_MESSAGE_TERM(msgp);
- if (is_non_value(ret)) {
+
+ if (is_non_value(ERL_MESSAGE_TERM(msgp))
+ && !erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) {
/*
* A corrupt distribution message that we weren't able to decode;
* remove it...
*/
ASSERT(!msgp->data.attached);
UNLINK_MESSAGE(c_p, msgp);
- free_message(msgp);
+ msgp->next = NULL;
+ erts_cleanup_messages(msgp);
goto next_message;
}
- return ret;
+
+ ASSERT(is_value(ERL_MESSAGE_TERM(msgp)));
+
+ return ERL_MESSAGE_TERM(msgp);
}
/*
diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index b7dae88417..0ecd13c4bc 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -38,9 +38,6 @@
*
* Our solution is to override the C library's signal handler setup
* procedure with our own which enforces the SA_ONSTACK flag.
- *
- * XXX: This code only supports Linux with glibc-2.1 or above,
- * and Solaris 8.
*/
#ifdef HAVE_CONFIG_H
#include "config.h"
@@ -55,27 +52,6 @@
#include "hipe_signal.h"
#if __GLIBC__ == 2 && (__GLIBC_MINOR__ >= 3)
-/* See comment below for glibc 2.2. */
-#ifndef __USE_GNU
-#define __USE_GNU /* to un-hide RTLD_NEXT */
-#endif
-#include <dlfcn.h>
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done() (__next_sigaction != 0)
-extern int __sigaction(int, const struct sigaction*, struct sigaction*);
-#define __SIGACTION __sigaction
-static void do_init(void)
-{
- __next_sigaction = dlsym(RTLD_NEXT, "__sigaction");
- if (__next_sigaction != 0)
- return;
- perror("dlsym");
- abort();
-}
-#define INIT() do { if (!init_done()) do_init(); } while (0)
-#endif /* glibc 2.3 */
-
-#if __GLIBC__ == 2 && (__GLIBC_MINOR__ == 2 /*|| __GLIBC_MINOR__ == 3*/)
/*
* __libc_sigaction() is the core routine.
* Without libpthread, sigaction() and __sigaction() are both aliases
@@ -100,65 +76,14 @@ static void do_init(void)
* old BSD or SysV interfaces.
* glibc's internal calls to __sigaction() appear to be mostly safe.
* hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler.
- *
- * Tested with glibc-2.1.92 on RedHat 7.0, glibc-2.2.2 on RedHat 7.1,
- * glibc-2.2.4 on RedHat 7.2, and glibc-2.2.5 on RedHat 7.3.
*/
-#if 0
-/* works with 2.2.5 and 2.2.4, but not 2.2.2 or 2.1.92 */
+#ifndef __USE_GNU
#define __USE_GNU /* to un-hide RTLD_NEXT */
-#include <dlfcn.h>
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done() (__next_sigaction != 0)
-#define __SIGACTION __sigaction
-static void do_init(void)
-{
- __next_sigaction = dlsym(RTLD_NEXT, "__sigaction");
- if (__next_sigaction != 0)
- return;
- perror("dlsym");
- abort();
-}
-#define INIT() do { if (!init_done()) do_init(); } while (0)
-#else
-/* semi-works with all 2.2 versions so far */
-extern int __sigaction(int, const struct sigaction*, struct sigaction*);
-#define __next_sigaction __sigaction /* pthreads-aware version */
-#undef __SIGACTION /* we can't override __sigaction() */
-#define INIT() do{}while(0)
#endif
-#endif /* glibc 2.2 */
-
-#if __GLIBC__ == 2 && __GLIBC_MINOR__ == 1
-/*
- * __sigaction() is the core routine.
- * Without libpthread, sigaction() is an alias for __sigaction().
- * libpthread redefines sigaction() as a non-trivial wrapper around
- * __sigaction().
- * glibc has internal calls to both sigaction() and __sigaction().
- *
- * Overriding __sigaction() would be ideal, but doing so breaks
- * libpthread (threads hang). Instead we override sigaction() and
- * use dlsym RTLD_NEXT to find glibc's version of sigaction().
- * glibc's internal calls to __sigaction() appear to be mostly safe.
- * hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler.
- *
- * Tested with glibc-2.1.3 on RedHat 6.2.
- */
-#include <dlfcn.h>
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done() (__next_sigaction != 0)
-#undef __SIGACTION
-static void do_init(void)
-{
- __next_sigaction = dlsym(RTLD_NEXT, "sigaction");
- if (__next_sigaction != 0)
- return;
- perror("dlsym");
- abort();
-}
-#define INIT() do { if (!init_done()) do_init(); } while (0)
-#endif /* glibc 2.1 */
+#define NEXT_SIGACTION "__sigaction"
+#define LIBC_SIGACTION __sigaction
+#define OVERRIDE_SIGACTION
+#endif /* glibc >= 2.3 */
/* Is there no standard identifier for Darwin/MacOSX ? */
#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
@@ -181,21 +106,10 @@ 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(__sun__)
@@ -218,20 +132,10 @@ 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.
*/
-#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 NEXT_SIGACTION "_sigaction"
+#define LIBC_SIGACTION _sigaction
+#define OVERRIDE_SIGACTION
#define _NSIG NSIG
-#define INIT() do { if (!init_done()) do_init(); } while (0)
#endif /* __sun__ */
#if defined(__FreeBSD__)
@@ -239,23 +143,22 @@ static void do_init(void)
* This is a copy of Darwin code for FreeBSD.
* CAVEAT: detailed semantics are not verified yet.
*/
-#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_freebsd");
- 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 /* __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
@@ -265,30 +168,40 @@ static void do_init(void)
* 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 __libc_sigaction
+static int (*next_sigaction)(int, const struct sigaction*, struct sigaction*);
static void do_init(void)
{
- __next_sigaction = dlsym(RTLD_NEXT, "__libc_sigaction");
- if (__next_sigaction != 0)
+ next_sigaction = dlsym(RTLD_NEXT, NEXT_SIGACTION);
+ if (next_sigaction != 0)
return;
perror("dlsym");
abort();
}
-#ifndef _NSIG
-#define _NSIG NSIG
-#endif
-#define INIT() do { if (!init_done()) do_init(); } while (0)
-#endif /* !(__GLIBC__ || __DARWIN__ || __NetBSD__ || __FreeBSD__ || __sun__) */
+#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)
{
@@ -304,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__) && !defined(__FreeBSD__)
int sigaction(int signum, const struct sigaction *act, struct sigaction *oldact)
{
return my_sigaction(signum, act, oldact);
@@ -336,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();
}
}
@@ -381,9 +292,7 @@ void hipe_signal_init(void)
struct sigaction sa;
int i;
-#ifndef __NetBSD__
INIT();
-#endif
hipe_sigaltstack_init();
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 105b129065..f87196d724 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -1337,11 +1337,7 @@ print_select_op(erts_dsprintf_buf_t *dsbufp,
{
Port *pp = erts_drvport2port(ix);
erts_dsprintf(dsbufp,
-#ifdef __OSE__
- "driver_select(%p, %d,%s%s%s%s | %d, %d) "
-#else
"driver_select(%p, %d,%s%s%s%s, %d) "
-#endif
"by ",
ix,
(int) GET_FD(fd),
@@ -1861,25 +1857,6 @@ stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode)
#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
-#ifdef __OSE__
-static SafeHashValue drv_ev_state_hash(void *des)
-{
- ErtsSysFdType fd = ((ErtsDrvEventState *) des)->fd;
- /* We use hash on signo ^ id in order for steal to happen when the
- same signo + fd is selected on by two different ports */
- SafeHashValue val = (SafeHashValue)(fd->signo ^ fd->id);
- return val ^ (val >> 8);
-}
-
-static int drv_ev_state_cmp(void *des1, void *des2)
-{
- ErtsSysFdType fd1 = ((ErtsDrvEventState *) des1)->fd;
- ErtsSysFdType fd2 = ((ErtsDrvEventState *) des2)->fd;
- if (fd1->signo == fd2->signo && fd1->id == fd2->id)
- return 0;
- return 1;
-}
-#else /* !__OSE__ && !ERTS_SYS_CONTINOUS_FD_NUMBERS i.e. probably windows */
static SafeHashValue drv_ev_state_hash(void *des)
{
SafeHashValue val = (SafeHashValue) ((ErtsDrvEventState *) des)->fd;
@@ -1891,7 +1868,6 @@ static int drv_ev_state_cmp(void *des1, void *des2)
return ( ((ErtsDrvEventState *) des1)->fd == ((ErtsDrvEventState *) des2)->fd
? 0 : 1);
}
-#endif
static void *drv_ev_state_alloc(void *des_tmpl)
{
diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c
index 754047829f..03ca080c14 100644
--- a/erts/emulator/sys/common/erl_mmap.c
+++ b/erts/emulator/sys/common/erl_mmap.c
@@ -51,23 +51,22 @@
#endif
/*
- * `mmap_state.sa.bot` and `mmap_state.sua.top` are read only after
+ * `mm->sa.bot` and `mm->sua.top` are read only after
* initialization, but the other pointers are not; i.e., only
* ERTS_MMAP_IN_SUPERCARRIER() is allowed without the mutex held.
*/
#define ERTS_MMAP_IN_SUPERCARRIER(PTR) \
- (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \
- < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sa.bot))
+ (((UWord) (PTR)) - ((UWord) mm->sa.bot) \
+ < ((UWord) mm->sua.top) - ((UWord) mm->sa.bot))
#define ERTS_MMAP_IN_SUPERALIGNED_AREA(PTR) \
- (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \
- (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \
- < ((UWord) mmap_state.sa.top) - ((UWord) mmap_state.sa.bot)))
+ (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mm->mtx)), \
+ (((UWord) (PTR)) - ((UWord) mm->sa.bot) \
+ < ((UWord) mm->sa.top) - ((UWord) mm->sa.bot)))
#define ERTS_MMAP_IN_SUPERUNALIGNED_AREA(PTR) \
- (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \
- (((UWord) (PTR)) - ((UWord) mmap_state.sua.bot) \
- < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sua.bot)))
+ (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mm->mtx)), \
+ (((UWord) (PTR)) - ((UWord) mm->sua.bot) \
+ < ((UWord) mm->sua.top) - ((UWord) mm->sua.bot)))
-int erts_have_erts_mmap;
UWord erts_page_inv_mask;
#if defined(DEBUG) || defined(ERTS_MMAP_DEBUG)
@@ -197,10 +196,10 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
#define ERTS_MMAP_OP_LCK(RES, IN_SZ, OUT_SZ) \
do { \
- erts_smp_mtx_lock(&mmap_state.mtx); \
+ erts_smp_mtx_lock(&mm->mtx); \
ERTS_MMAP_OP_START((IN_SZ)); \
ERTS_MMAP_OP_END((RES), (OUT_SZ)); \
- erts_smp_mtx_unlock(&mmap_state.mtx); \
+ erts_smp_mtx_unlock(&mm->mtx); \
} while (0)
#define ERTS_MUNMAP_OP(PTR, SZ) \
@@ -219,9 +218,9 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
#define ERTS_MUNMAP_OP_LCK(PTR, SZ) \
do { \
- erts_smp_mtx_lock(&mmap_state.mtx); \
+ erts_smp_mtx_lock(&mm->mtx); \
ERTS_MUNMAP_OP((PTR), (SZ)); \
- erts_smp_mtx_unlock(&mmap_state.mtx); \
+ erts_smp_mtx_unlock(&mm->mtx); \
} while (0)
#define ERTS_MREMAP_OP_START(OLD_PTR, OLD_SZ, IN_SZ) \
@@ -247,10 +246,10 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
#define ERTS_MREMAP_OP_LCK(RES, OLD_PTR, OLD_SZ, IN_SZ, OUT_SZ) \
do { \
- erts_smp_mtx_lock(&mmap_state.mtx); \
+ erts_smp_mtx_lock(&mm->mtx); \
ERTS_MREMAP_OP_START((OLD_PTR), (OLD_SZ), (IN_SZ)); \
ERTS_MREMAP_OP_END((RES), (OUT_SZ)); \
- erts_smp_mtx_unlock(&mmap_state.mtx); \
+ erts_smp_mtx_unlock(&mm->mtx); \
} while (0)
#define ERTS_MMAP_OP_ABORT() \
@@ -294,7 +293,7 @@ typedef struct {
Uint nseg;
}ErtsFreeSegMap;
-static struct {
+struct ErtsMemMapper_ {
int (*reserve_physical)(char *, UWord);
void (*unreserve_physical)(char *, UWord);
int supercarrier;
@@ -346,54 +345,62 @@ static struct {
UWord used;
} os;
} size;
-} mmap_state;
+};
+
+ErtsMemMapper erts_dflt_mmapper;
+
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ErtsMemMapper erts_literal_mmapper;
+char* erts_literals_start;
+UWord erts_literals_size;
+#endif
#define ERTS_MMAP_SIZE_SC_SA_INC(SZ) \
do { \
- mmap_state.size.supercarrier.used.total += (SZ); \
- mmap_state.size.supercarrier.used.sa += (SZ); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \
- <= mmap_state.size.supercarrier.total); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa \
- <= mmap_state.size.supercarrier.used.total); \
+ mm->size.supercarrier.used.total += (SZ); \
+ mm->size.supercarrier.used.sa += (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total \
+ <= mm->size.supercarrier.total); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sa \
+ <= mm->size.supercarrier.used.total); \
} while (0)
#define ERTS_MMAP_SIZE_SC_SA_DEC(SZ) \
do { \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \
- mmap_state.size.supercarrier.used.total -= (SZ); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa >= (SZ)); \
- mmap_state.size.supercarrier.used.sa -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total >= (SZ)); \
+ mm->size.supercarrier.used.total -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sa >= (SZ)); \
+ mm->size.supercarrier.used.sa -= (SZ); \
} while (0)
#define ERTS_MMAP_SIZE_SC_SUA_INC(SZ) \
do { \
- mmap_state.size.supercarrier.used.total += (SZ); \
- mmap_state.size.supercarrier.used.sua += (SZ); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \
- <= mmap_state.size.supercarrier.total); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua \
- <= mmap_state.size.supercarrier.used.total); \
+ mm->size.supercarrier.used.total += (SZ); \
+ mm->size.supercarrier.used.sua += (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total \
+ <= mm->size.supercarrier.total); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sua \
+ <= mm->size.supercarrier.used.total); \
} while (0)
#define ERTS_MMAP_SIZE_SC_SUA_DEC(SZ) \
do { \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \
- mmap_state.size.supercarrier.used.total -= (SZ); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua >= (SZ)); \
- mmap_state.size.supercarrier.used.sua -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total >= (SZ)); \
+ mm->size.supercarrier.used.total -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sua >= (SZ)); \
+ mm->size.supercarrier.used.sua -= (SZ); \
} while (0)
#define ERTS_MMAP_SIZE_OS_INC(SZ) \
do { \
- ERTS_MMAP_ASSERT(mmap_state.size.os.used + (SZ) >= (SZ)); \
- mmap_state.size.os.used += (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.os.used + (SZ) >= (SZ)); \
+ mm->size.os.used += (SZ); \
} while (0)
#define ERTS_MMAP_SIZE_OS_DEC(SZ) \
do { \
- ERTS_MMAP_ASSERT(mmap_state.size.os.used >= (SZ)); \
- mmap_state.size.os.used -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.os.used >= (SZ)); \
+ mm->size.os.used -= (SZ); \
} while (0)
static void
-add_free_desc_area(char *start, char *end)
+add_free_desc_area(ErtsMemMapper* mm, char *start, char *end)
{
ERTS_MMAP_ASSERT(end == (void *) 0 || end > start);
if (sizeof(ErtsFreeSegDesc) <= ((UWord) end) - ((UWord) start)) {
@@ -403,7 +410,7 @@ add_free_desc_area(char *start, char *end)
no = 1;
prev_desc = (ErtsFreeSegDesc *) start;
- prev_desc->start = mmap_state.desc.free_list;
+ prev_desc->start = mm->desc.free_list;
desc = (ErtsFreeSegDesc *) (start + sizeof(ErtsFreeSegDesc));
desc_end = start + 2*sizeof(ErtsFreeSegDesc);
@@ -414,59 +421,59 @@ add_free_desc_area(char *start, char *end)
desc_end += sizeof(ErtsFreeSegDesc);
no++;
}
- mmap_state.desc.free_list = (char *) prev_desc;
- mmap_state.no.free_seg_descs += no;
+ mm->desc.free_list = (char *) prev_desc;
+ mm->no.free_seg_descs += no;
}
}
static ErtsFreeSegDesc *
-add_unused_free_desc_area(void)
+add_unused_free_desc_area(ErtsMemMapper* mm)
{
char *ptr;
- if (!mmap_state.desc.unused_start)
+ if (!mm->desc.unused_start)
return NULL;
- ERTS_MMAP_ASSERT(mmap_state.desc.unused_end);
+ ERTS_MMAP_ASSERT(mm->desc.unused_end);
ERTS_MMAP_ASSERT(ERTS_PAGEALIGNED_SIZE
- <= mmap_state.desc.unused_end - mmap_state.desc.unused_start);
+ <= mm->desc.unused_end - mm->desc.unused_start);
- ptr = mmap_state.desc.unused_start + ERTS_PAGEALIGNED_SIZE;
- add_free_desc_area(mmap_state.desc.unused_start, ptr);
+ ptr = mm->desc.unused_start + ERTS_PAGEALIGNED_SIZE;
+ add_free_desc_area(mm, mm->desc.unused_start, ptr);
- if ((mmap_state.desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE)
- mmap_state.desc.unused_start = ptr;
+ if ((mm->desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE)
+ mm->desc.unused_start = ptr;
else
- mmap_state.desc.unused_end = mmap_state.desc.unused_start = NULL;
+ mm->desc.unused_end = mm->desc.unused_start = NULL;
- ERTS_MMAP_ASSERT(mmap_state.desc.free_list);
- return (ErtsFreeSegDesc *) mmap_state.desc.free_list;
+ ERTS_MMAP_ASSERT(mm->desc.free_list);
+ return (ErtsFreeSegDesc *) mm->desc.free_list;
}
static ERTS_INLINE ErtsFreeSegDesc *
-alloc_desc(void)
+alloc_desc(ErtsMemMapper* mm)
{
ErtsFreeSegDesc *res;
- res = (ErtsFreeSegDesc *) mmap_state.desc.free_list;
+ res = (ErtsFreeSegDesc *) mm->desc.free_list;
if (!res) {
- res = add_unused_free_desc_area();
+ res = add_unused_free_desc_area(mm);
if (!res)
return NULL;
}
- mmap_state.desc.free_list = res->start;
- ASSERT(mmap_state.no.free_segs.curr < mmap_state.no.free_seg_descs);
- mmap_state.no.free_segs.curr++;
- if (mmap_state.no.free_segs.max < mmap_state.no.free_segs.curr)
- mmap_state.no.free_segs.max = mmap_state.no.free_segs.curr;
+ mm->desc.free_list = res->start;
+ ASSERT(mm->no.free_segs.curr < mm->no.free_seg_descs);
+ mm->no.free_segs.curr++;
+ if (mm->no.free_segs.max < mm->no.free_segs.curr)
+ mm->no.free_segs.max = mm->no.free_segs.curr;
return res;
}
static ERTS_INLINE void
-free_desc(ErtsFreeSegDesc *desc)
+free_desc(ErtsMemMapper* mm, ErtsFreeSegDesc *desc)
{
- desc->start = mmap_state.desc.free_list;
- mmap_state.desc.free_list = (char *) desc;
- ERTS_MMAP_ASSERT(mmap_state.no.free_segs.curr > 0);
- mmap_state.no.free_segs.curr--;
+ desc->start = mm->desc.free_list;
+ mm->desc.free_list = (char *) desc;
+ ERTS_MMAP_ASSERT(mm->no.free_segs.curr > 0);
+ mm->no.free_segs.curr--;
}
static ERTS_INLINE ErtsFreeSegDesc* anode_to_desc(RBTNode* anode)
@@ -1233,7 +1240,7 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map)
# define ERTS_MMAP_FD (-1)
# else
# define ERTS_MMAP_FLAGS (MAP_PRIVATE)
-# define ERTS_MMAP_FD mmap_state.mmap_fd
+# define ERTS_MMAP_FD mm->mmap_fd
# endif
#endif
@@ -1378,11 +1385,12 @@ static void unreserve_noop(char *ptr, UWord size)
}
static UWord
-alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
+alloc_desc_insert_free_seg(ErtsMemMapper* mm,
+ ErtsFreeSegMap *map, char* start, char* end)
{
char *ptr;
ErtsFreeSegMap *da_map;
- ErtsFreeSegDesc *desc = alloc_desc();
+ ErtsFreeSegDesc *desc = alloc_desc(mm);
if (desc) {
insert_free_seg(map, desc, start, end);
return 0;
@@ -1395,13 +1403,13 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
*/
#if ERTS_HAVE_OS_MMAP
- if (!mmap_state.no_os_mmap) {
- ptr = os_mmap(mmap_state.desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0);
+ if (!mm->no_os_mmap) {
+ ptr = os_mmap(mm->desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0);
if (ptr) {
- mmap_state.desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE;
+ mm->desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE;
ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE);
- add_free_desc_area(ptr, ptr+ERTS_PAGEALIGNED_SIZE);
- desc = alloc_desc();
+ add_free_desc_area(mm, ptr, ptr+ERTS_PAGEALIGNED_SIZE);
+ desc = alloc_desc(mm);
ERTS_MMAP_ASSERT(desc);
insert_free_seg(map, desc, start, end);
return 0;
@@ -1412,20 +1420,20 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
/*
* ...then try to find a good place in the supercarrier...
*/
- da_map = &mmap_state.sua.map;
+ da_map = &mm->sua.map;
desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
if (desc) {
- if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
+ if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE);
else
desc = NULL;
}
else {
- da_map = &mmap_state.sa.map;
+ da_map = &mm->sa.map;
desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
if (desc) {
- if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
+ if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
ERTS_MMAP_SIZE_SC_SA_INC(ERTS_PAGEALIGNED_SIZE);
else
desc = NULL;
@@ -1433,15 +1441,15 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
}
if (desc) {
char *da_end = desc->start + ERTS_PAGEALIGNED_SIZE;
- add_free_desc_area(desc->start, da_end);
+ add_free_desc_area(mm, desc->start, da_end);
if (da_end != desc->end)
resize_free_seg(da_map, desc, da_end, desc->end);
else {
delete_free_seg(da_map, desc);
- free_desc(desc);
+ free_desc(mm, desc);
}
- desc = alloc_desc();
+ desc = alloc_desc(mm);
ERTS_MMAP_ASSERT(desc);
insert_free_seg(map, desc, start, end);
return 0;
@@ -1454,10 +1462,10 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
ptr = start + ERTS_PAGEALIGNED_SIZE;
ERTS_MMAP_ASSERT(ptr <= end);
- add_free_desc_area(start, ptr);
+ add_free_desc_area(mm, start, ptr);
if (ptr != end) {
- desc = alloc_desc();
+ desc = alloc_desc(mm);
ERTS_MMAP_ASSERT(desc);
insert_free_seg(map, desc, ptr, end);
}
@@ -1466,46 +1474,46 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
}
void *
-erts_mmap(Uint32 flags, UWord *sizep)
+erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
{
char *seg;
UWord asize = ERTS_PAGEALIGNED_CEILING(*sizep);
/* Map in premapped supercarrier */
- if (mmap_state.supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) {
+ if (mm->supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) {
char *end;
ErtsFreeSegDesc *desc;
Uint32 superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
- erts_smp_mtx_lock(&mmap_state.mtx);
+ erts_smp_mtx_lock(&mm->mtx);
ERTS_MMAP_OP_START(*sizep);
if (!superaligned) {
- desc = lookup_free_seg(&mmap_state.sua.map, asize);
+ desc = lookup_free_seg(&mm->sua.map, asize);
if (desc) {
seg = desc->start;
end = seg+asize;
- if (!mmap_state.reserve_physical(seg, asize))
+ if (!mm->reserve_physical(seg, asize))
goto supercarrier_reserve_failure;
if (desc->end == end) {
- delete_free_seg(&mmap_state.sua.map, desc);
- free_desc(desc);
+ delete_free_seg(&mm->sua.map, desc);
+ free_desc(mm, desc);
}
else {
ERTS_MMAP_ASSERT(end < desc->end);
- resize_free_seg(&mmap_state.sua.map, desc, end, desc->end);
+ resize_free_seg(&mm->sua.map, desc, end, desc->end);
}
ERTS_MMAP_SIZE_SC_SUA_INC(asize);
goto supercarrier_success;
}
- if (asize <= mmap_state.sua.bot - mmap_state.sa.top) {
- if (!mmap_state.reserve_physical(mmap_state.sua.bot - asize,
+ if (asize <= mm->sua.bot - mm->sa.top) {
+ if (!mm->reserve_physical(mm->sua.bot - asize,
asize))
goto supercarrier_reserve_failure;
- mmap_state.sua.bot -= asize;
- seg = mmap_state.sua.bot;
+ mm->sua.bot -= asize;
+ seg = mm->sua.bot;
ERTS_MMAP_SIZE_SC_SUA_INC(asize);
goto supercarrier_success;
}
@@ -1513,84 +1521,84 @@ erts_mmap(Uint32 flags, UWord *sizep)
asize = ERTS_SUPERALIGNED_CEILING(asize);
- desc = lookup_free_seg(&mmap_state.sa.map, asize);
+ desc = lookup_free_seg(&mm->sa.map, asize);
if (desc) {
char *start = seg = desc->start;
seg = (char *) ERTS_SUPERALIGNED_CEILING(seg);
end = seg+asize;
- if (!mmap_state.reserve_physical(start, (UWord) (end - start)))
+ if (!mm->reserve_physical(start, (UWord) (end - start)))
goto supercarrier_reserve_failure;
ERTS_MMAP_SIZE_SC_SA_INC(asize);
if (desc->end == end) {
if (start != seg)
- resize_free_seg(&mmap_state.sa.map, desc, start, seg);
+ resize_free_seg(&mm->sa.map, desc, start, seg);
else {
- delete_free_seg(&mmap_state.sa.map, desc);
- free_desc(desc);
+ delete_free_seg(&mm->sa.map, desc);
+ free_desc(mm, desc);
}
}
else {
ERTS_MMAP_ASSERT(end < desc->end);
- resize_free_seg(&mmap_state.sa.map, desc, end, desc->end);
+ resize_free_seg(&mm->sa.map, desc, end, desc->end);
if (start != seg) {
UWord ad_sz;
- ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+ ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map,
start, seg);
start += ad_sz;
if (start != seg)
- mmap_state.unreserve_physical(start, (UWord) (seg - start));
+ mm->unreserve_physical(start, (UWord) (seg - start));
}
}
goto supercarrier_success;
}
if (superaligned) {
- char *start = mmap_state.sa.top;
+ char *start = mm->sa.top;
seg = (char *) ERTS_SUPERALIGNED_CEILING(start);
- if (asize + (seg - start) <= mmap_state.sua.bot - start) {
+ if (asize + (seg - start) <= mm->sua.bot - start) {
end = seg + asize;
- if (!mmap_state.reserve_physical(start, (UWord) (end - start)))
+ if (!mm->reserve_physical(start, (UWord) (end - start)))
goto supercarrier_reserve_failure;
- mmap_state.sa.top = end;
+ mm->sa.top = end;
ERTS_MMAP_SIZE_SC_SA_INC(asize);
if (start != seg) {
UWord ad_sz;
- ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+ ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map,
start, seg);
start += ad_sz;
if (start != seg)
- mmap_state.unreserve_physical(start, (UWord) (seg - start));
+ mm->unreserve_physical(start, (UWord) (seg - start));
}
goto supercarrier_success;
}
- desc = lookup_free_seg(&mmap_state.sua.map, asize + ERTS_SUPERALIGNED_SIZE);
+ desc = lookup_free_seg(&mm->sua.map, asize + ERTS_SUPERALIGNED_SIZE);
if (desc) {
char *org_start = desc->start;
char *org_end = desc->end;
seg = (char *) ERTS_SUPERALIGNED_CEILING(org_start);
end = seg + asize;
- if (!mmap_state.reserve_physical(seg, (UWord) (org_end - seg)))
+ if (!mm->reserve_physical(seg, (UWord) (org_end - seg)))
goto supercarrier_reserve_failure;
ERTS_MMAP_SIZE_SC_SUA_INC(asize);
if (org_start != seg) {
ERTS_MMAP_ASSERT(org_start < seg);
- resize_free_seg(&mmap_state.sua.map, desc, org_start, seg);
+ resize_free_seg(&mm->sua.map, desc, org_start, seg);
desc = NULL;
}
if (end != org_end) {
UWord ad_sz = 0;
ERTS_MMAP_ASSERT(end < org_end);
if (desc)
- resize_free_seg(&mmap_state.sua.map, desc, end, org_end);
+ resize_free_seg(&mm->sua.map, desc, end, org_end);
else
- ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+ ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map,
end, org_end);
end += ad_sz;
if (end != org_end)
- mmap_state.unreserve_physical(end,
+ mm->unreserve_physical(end,
(UWord) (org_end - end));
}
goto supercarrier_success;
@@ -1598,12 +1606,12 @@ erts_mmap(Uint32 flags, UWord *sizep)
}
ERTS_MMAP_OP_ABORT();
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
}
#if ERTS_HAVE_OS_MMAP
/* Map using OS primitives */
- if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mmap_state.no_os_mmap) {
+ if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mm->no_os_mmap) {
if (!(ERTS_MMAPFLG_SUPERALIGNED & flags)) {
seg = os_mmap(NULL, asize, 0);
if (!seg)
@@ -1661,25 +1669,25 @@ supercarrier_success:
#endif
ERTS_MMAP_OP_END(seg, asize);
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
*sizep = asize;
return (void *) seg;
supercarrier_reserve_failure:
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
*sizep = 0;
return NULL;
}
void
-erts_munmap(Uint32 flags, void *ptr, UWord size)
+erts_munmap(ErtsMemMapper* mm, Uint32 flags, void *ptr, UWord size)
{
ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr));
ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(size));
if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) {
- ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap);
+ ERTS_MMAP_ASSERT(!mm->no_os_mmap);
#if ERTS_HAVE_OS_MMAP
ERTS_MUNMAP_OP_LCK(ptr, size);
ERTS_MMAP_SIZE_OS_DEC(size);
@@ -1692,45 +1700,45 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
ErtsFreeSegDesc *prev, *next, *desc;
UWord ad_sz = 0;
- ERTS_MMAP_ASSERT(mmap_state.supercarrier);
+ ERTS_MMAP_ASSERT(mm->supercarrier);
start = (char *) ptr;
end = start + size;
- erts_smp_mtx_lock(&mmap_state.mtx);
+ erts_smp_mtx_lock(&mm->mtx);
ERTS_MUNMAP_OP(ptr, size);
if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) {
- map = &mmap_state.sa.map;
+ map = &mm->sa.map;
adjacent_free_seg(map, start, end, &prev, &next);
ERTS_MMAP_SIZE_SC_SA_DEC(size);
- if (end == mmap_state.sa.top) {
+ if (end == mm->sa.top) {
ERTS_MMAP_ASSERT(!next);
if (prev) {
start = prev->start;
delete_free_seg(map, prev);
- free_desc(prev);
+ free_desc(mm, prev);
}
- mmap_state.sa.top = start;
+ mm->sa.top = start;
goto supercarrier_success;
}
}
else {
- map = &mmap_state.sua.map;
+ map = &mm->sua.map;
adjacent_free_seg(map, start, end, &prev, &next);
ERTS_MMAP_SIZE_SC_SUA_DEC(size);
- if (start == mmap_state.sua.bot) {
+ if (start == mm->sua.bot) {
ERTS_MMAP_ASSERT(!prev);
if (next) {
end = next->end;
delete_free_seg(map, next);
- free_desc(next);
+ free_desc(mm, next);
}
- mmap_state.sua.bot = end;
+ mm->sua.bot = end;
goto supercarrier_success;
}
}
@@ -1742,7 +1750,7 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
end = next->end;
if (prev) {
delete_free_seg(map, next);
- free_desc(next);
+ free_desc(mm, next);
goto save_prev;
}
desc = next;
@@ -1756,7 +1764,7 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
if (desc)
resize_free_seg(map, desc, start, end);
else
- ad_sz = alloc_desc_insert_free_seg(map, start, end);
+ ad_sz = alloc_desc_insert_free_seg(mm, map, start, end);
supercarrier_success: {
UWord unres_sz;
@@ -1764,30 +1772,32 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
ERTS_MMAP_ASSERT(size >= ad_sz);
unres_sz = size - ad_sz;
if (unres_sz)
- mmap_state.unreserve_physical(((char *) ptr) + ad_sz, unres_sz);
+ mm->unreserve_physical(((char *) ptr) + ad_sz, unres_sz);
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
}
}
}
static void *
-remap_move(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
+remap_move(ErtsMemMapper* mm,
+ Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
{
UWord size = *sizep;
- void *new_ptr = erts_mmap(flags, &size);
+ void *new_ptr = erts_mmap(mm, flags, &size);
if (!new_ptr)
return NULL;
*sizep = size;
if (old_size < size)
size = old_size;
sys_memcpy(new_ptr, ptr, (size_t) size);
- erts_munmap(flags, ptr, old_size);
+ erts_munmap(mm, flags, ptr, old_size);
return new_ptr;
}
void *
-erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
+erts_mremap(ErtsMemMapper* mm,
+ Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
{
void *new_ptr;
Uint32 superaligned;
@@ -1799,11 +1809,11 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) {
- ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap);
+ ERTS_MMAP_ASSERT(!mm->no_os_mmap);
- if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mmap_state.supercarrier) {
- new_ptr = remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr,
- old_size, sizep);
+ if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mm->supercarrier) {
+ new_ptr = remap_move(mm, ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags,
+ ptr, old_size, sizep);
if (new_ptr)
return new_ptr;
}
@@ -1850,7 +1860,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
#endif
#if ERTS_HAVE_OS_MREMAP
if (superaligned)
- return remap_move(flags, new_ptr, old_size, sizep);
+ return remap_move(mm, flags, new_ptr, old_size, sizep);
else {
new_ptr = os_mremap(ptr, old_size, asize, 0);
if (!new_ptr)
@@ -1872,10 +1882,10 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
ErtsFreeSegDesc *prev, *next;
UWord ad_sz = 0;
- ERTS_MMAP_ASSERT(mmap_state.supercarrier);
+ ERTS_MMAP_ASSERT(mm->supercarrier);
if (ERTS_MMAPFLG_OS_ONLY & flags)
- return remap_move(flags, ptr, old_size, sizep);
+ return remap_move(mm, flags, ptr, old_size, sizep);
superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
@@ -1883,19 +1893,19 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
? ERTS_SUPERALIGNED_CEILING(*sizep)
: ERTS_PAGEALIGNED_CEILING(*sizep));
- erts_smp_mtx_lock(&mmap_state.mtx);
+ erts_smp_mtx_lock(&mm->mtx);
if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)
- ? (!superaligned && lookup_free_seg(&mmap_state.sua.map, asize))
- : (superaligned && lookup_free_seg(&mmap_state.sa.map, asize))) {
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ ? (!superaligned && lookup_free_seg(&mm->sua.map, asize))
+ : (superaligned && lookup_free_seg(&mm->sa.map, asize))) {
+ erts_smp_mtx_unlock(&mm->mtx);
/*
* Segment currently in wrong area (due to a previous memory
* shortage), move it to the right area.
* (remap_move() will succeed)
*/
- return remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr,
- old_size, sizep);
+ return remap_move(mm, ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags,
+ ptr, old_size, sizep);
}
ERTS_MREMAP_OP_START(ptr, old_size, *sizep);
@@ -1917,18 +1927,18 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
UWord unres_sz;
new_ptr = ptr;
if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) {
- map = &mmap_state.sua.map;
+ map = &mm->sua.map;
ERTS_MMAP_SIZE_SC_SUA_DEC(old_size - asize);
}
else {
- if (end == mmap_state.sa.top) {
- mmap_state.sa.top = new_end;
- mmap_state.unreserve_physical(((char *) ptr) + asize,
+ if (end == mm->sa.top) {
+ mm->sa.top = new_end;
+ mm->unreserve_physical(((char *) ptr) + asize,
old_size - asize);
goto supercarrier_resize_success;
}
ERTS_MMAP_SIZE_SC_SA_DEC(old_size - asize);
- map = &mmap_state.sa.map;
+ map = &mm->sa.map;
}
adjacent_free_seg(map, start, end, &prev, &next);
@@ -1936,11 +1946,11 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
if (next)
resize_free_seg(map, next, new_end, next->end);
else
- ad_sz = alloc_desc_insert_free_seg(map, new_end, end);
+ ad_sz = alloc_desc_insert_free_seg(mm, map, new_end, end);
ERTS_MMAP_ASSERT(old_size - asize >= ad_sz);
unres_sz = old_size - asize - ad_sz;
if (unres_sz)
- mmap_state.unreserve_physical(((char *) ptr) + asize + ad_sz,
+ mm->unreserve_physical(((char *) ptr) + asize + ad_sz,
unres_sz);
goto supercarrier_resize_success;
}
@@ -1950,17 +1960,17 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size));
ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize));
- adjacent_free_seg(&mmap_state.sua.map, start, end, &prev, &next);
+ adjacent_free_seg(&mm->sua.map, start, end, &prev, &next);
if (next && new_end <= next->end) {
- if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+ if (!mm->reserve_physical(((char *) ptr) + old_size,
asize - old_size))
goto supercarrier_reserve_failure;
if (new_end < next->end)
- resize_free_seg(&mmap_state.sua.map, next, new_end, next->end);
+ resize_free_seg(&mm->sua.map, next, new_end, next->end);
else {
- delete_free_seg(&mmap_state.sua.map, next);
- free_desc(next);
+ delete_free_seg(&mm->sua.map, next);
+ free_desc(mm, next);
}
new_ptr = ptr;
ERTS_MMAP_SIZE_SC_SUA_INC(asize - old_size);
@@ -1969,28 +1979,28 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
}
else { /* Superaligned area */
- if (end == mmap_state.sa.top) {
- if (new_end <= mmap_state.sua.bot) {
- if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+ if (end == mm->sa.top) {
+ if (new_end <= mm->sua.bot) {
+ if (!mm->reserve_physical(((char *) ptr) + old_size,
asize - old_size))
goto supercarrier_reserve_failure;
- mmap_state.sa.top = new_end;
+ mm->sa.top = new_end;
new_ptr = ptr;
ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size);
goto supercarrier_resize_success;
}
}
else {
- adjacent_free_seg(&mmap_state.sa.map, start, end, &prev, &next);
+ adjacent_free_seg(&mm->sa.map, start, end, &prev, &next);
if (next && new_end <= next->end) {
- if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+ if (!mm->reserve_physical(((char *) ptr) + old_size,
asize - old_size))
goto supercarrier_reserve_failure;
if (new_end < next->end)
- resize_free_seg(&mmap_state.sa.map, next, new_end, next->end);
+ resize_free_seg(&mm->sa.map, next, new_end, next->end);
else {
- delete_free_seg(&mmap_state.sa.map, next);
- free_desc(next);
+ delete_free_seg(&mm->sa.map, next);
+ free_desc(mm, next);
}
new_ptr = ptr;
ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size);
@@ -2000,12 +2010,12 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
}
ERTS_MMAP_OP_ABORT();
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
/* Failed to resize... */
}
- return remap_move(flags, ptr, old_size, sizep);
+ return remap_move(mm, flags, ptr, old_size, sizep);
supercarrier_resize_success:
@@ -2022,25 +2032,24 @@ supercarrier_resize_success:
#endif
ERTS_MREMAP_OP_END(new_ptr, asize);
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
*sizep = asize;
return new_ptr;
supercarrier_reserve_failure:
ERTS_MREMAP_OP_END(NULL, old_size);
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
*sizep = old_size;
return NULL;
}
-int erts_mmap_in_supercarrier(void *ptr)
+int erts_mmap_in_supercarrier(ErtsMemMapper* mm, void *ptr)
{
return ERTS_MMAP_IN_SUPERCARRIER(ptr);
}
-
static struct {
Eterm total;
Eterm total_sa;
@@ -2103,8 +2112,9 @@ static void hard_dbg_mseg_init(void);
#endif
void
-erts_mmap_init(ErtsMMapInit *init)
+erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init)
{
+ static int is_first_call = 1;
int virtual_map = 0;
char *start = NULL, *end = NULL;
UWord pagesize;
@@ -2131,20 +2141,20 @@ erts_mmap_init(ErtsMMapInit *init)
ERTS_MMAP_OP_RINGBUF_INIT();
- erts_have_erts_mmap = 0;
-
- mmap_state.supercarrier = 0;
- mmap_state.reserve_physical = reserve_noop;
- mmap_state.unreserve_physical = unreserve_noop;
+ mm->supercarrier = 0;
+ mm->reserve_physical = reserve_noop;
+ mm->unreserve_physical = unreserve_noop;
#if HAVE_MMAP && !defined(MAP_ANON)
- mmap_state.mmap_fd = open("/dev/zero", O_RDWR);
- if (mmap_state.mmap_fd < 0)
+ mm->mmap_fd = open("/dev/zero", O_RDWR);
+ if (mm->mmap_fd < 0)
erl_exit(-1, "erts_mmap: Failed to open /dev/zero\n");
#endif
- erts_smp_mtx_init(&mmap_state.mtx, "erts_mmap");
- erts_mtx_init(&am.init_mutex, "mmap_init_atoms");
+ erts_smp_mtx_init(&mm->mtx, "erts_mmap");
+ if (is_first_call) {
+ erts_mtx_init(&am.init_mutex, "mmap_init_atoms");
+ }
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
if (init->virtual_range.start) {
@@ -2160,8 +2170,8 @@ erts_mmap_init(ErtsMMapInit *init)
sz = start - ptr;
if (sz)
os_munmap(end, sz);
- mmap_state.reserve_physical = os_reserve_physical;
- mmap_state.unreserve_physical = os_unreserve_physical;
+ mm->reserve_physical = os_reserve_physical;
+ mm->unreserve_physical = os_unreserve_physical;
virtual_map = 1;
}
else
@@ -2179,8 +2189,8 @@ erts_mmap_init(ErtsMMapInit *init)
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
if (!init->scrpm) {
start = os_mmap_virtual(NULL, sz);
- mmap_state.reserve_physical = os_reserve_physical;
- mmap_state.unreserve_physical = os_unreserve_physical;
+ mm->reserve_physical = os_reserve_physical;
+ mm->unreserve_physical = os_unreserve_physical;
virtual_map = 1;
}
else
@@ -2206,34 +2216,32 @@ erts_mmap_init(ErtsMMapInit *init)
}
#endif
}
- if (!mmap_state.no_os_mmap)
- erts_have_erts_mmap |= ERTS_HAVE_ERTS_OS_MMAP;
#endif
- mmap_state.no.free_seg_descs = 0;
- mmap_state.no.free_segs.curr = 0;
- mmap_state.no.free_segs.max = 0;
+ mm->no.free_seg_descs = 0;
+ mm->no.free_segs.curr = 0;
+ mm->no.free_segs.max = 0;
- mmap_state.size.supercarrier.total = 0;
- mmap_state.size.supercarrier.used.total = 0;
- mmap_state.size.supercarrier.used.sa = 0;
- mmap_state.size.supercarrier.used.sua = 0;
- mmap_state.size.os.used = 0;
+ mm->size.supercarrier.total = 0;
+ mm->size.supercarrier.used.total = 0;
+ mm->size.supercarrier.used.sa = 0;
+ mm->size.supercarrier.used.sua = 0;
+ mm->size.os.used = 0;
- mmap_state.desc.new_area_hint = NULL;
+ mm->desc.new_area_hint = NULL;
if (!start) {
- mmap_state.sa.bot = NULL;
- mmap_state.sua.top = NULL;
- mmap_state.sa.bot = NULL;
- mmap_state.sua.top = NULL;
- mmap_state.no_os_mmap = 0;
- mmap_state.supercarrier = 0;
+ mm->sa.bot = NULL;
+ mm->sua.top = NULL;
+ mm->sa.bot = NULL;
+ mm->sua.top = NULL;
+ mm->no_os_mmap = 0;
+ mm->supercarrier = 0;
}
else {
size_t desc_size;
- mmap_state.no_os_mmap = init->sco;
+ mm->no_os_mmap = init->sco;
desc_size = init->scrfsd;
if (desc_size < 100)
@@ -2244,66 +2252,73 @@ erts_mmap_init(ErtsMMapInit *init)
+ ERTS_PAGEALIGNED_SIZE) > end - start)
erl_exit(-1, "erts_mmap: No space for segments in super carrier\n");
- mmap_state.sa.bot = start;
- mmap_state.sa.bot += desc_size;
- mmap_state.sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mmap_state.sa.bot);
- mmap_state.sa.top = mmap_state.sa.bot;
- mmap_state.sua.top = end;
- mmap_state.sua.bot = mmap_state.sua.top;
+ mm->sa.bot = start;
+ mm->sa.bot += desc_size;
+ mm->sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mm->sa.bot);
+ mm->sa.top = mm->sa.bot;
+ mm->sua.top = end;
+ mm->sua.bot = mm->sua.top;
- mmap_state.size.supercarrier.used.total += (UWord) (mmap_state.sa.bot - start);
+ mm->size.supercarrier.used.total += (UWord) (mm->sa.bot - start);
- mmap_state.desc.free_list = NULL;
- mmap_state.desc.reserved = 0;
+ mm->desc.free_list = NULL;
+ mm->desc.reserved = 0;
if (end == (void *) 0) {
/*
* Very unlikely, but we need a guarantee
- * that `mmap_state.sua.top` always will
+ * that `mm->sua.top` always will
* compare as larger than all segment pointers
* into the super carrier...
*/
- mmap_state.sua.top -= ERTS_PAGEALIGNED_SIZE;
- mmap_state.size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE;
+ mm->sua.top -= ERTS_PAGEALIGNED_SIZE;
+ mm->size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE;
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
- if (!virtual_map || os_reserve_physical(mmap_state.sua.top, ERTS_PAGEALIGNED_SIZE))
+ if (!virtual_map || os_reserve_physical(mm->sua.top, ERTS_PAGEALIGNED_SIZE))
#endif
- add_free_desc_area(mmap_state.sua.top, end);
- mmap_state.desc.reserved += (end - mmap_state.sua.top) / sizeof(ErtsFreeSegDesc);
+ add_free_desc_area(mm, mm->sua.top, end);
+ mm->desc.reserved += (end - mm->sua.top) / sizeof(ErtsFreeSegDesc);
}
- mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - start);
+ mm->size.supercarrier.total = (UWord) (mm->sua.top - start);
/*
* Area before (and after) super carrier
* will be used for free segment descritors.
*/
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
- if (virtual_map && !os_reserve_physical(start, mmap_state.sa.bot - start))
+ if (virtual_map && !os_reserve_physical(start, mm->sa.bot - start))
erl_exit(-1, "erts_mmap: Failed to reserve physical memory for descriptors\n");
#endif
- mmap_state.desc.unused_start = start;
- mmap_state.desc.unused_end = mmap_state.sa.bot;
- mmap_state.desc.reserved += ((mmap_state.desc.unused_end - start)
+ mm->desc.unused_start = start;
+ mm->desc.unused_end = mm->sa.bot;
+ mm->desc.reserved += ((mm->desc.unused_end - start)
/ sizeof(ErtsFreeSegDesc));
- init_free_seg_map(&mmap_state.sa.map, SA_SZ_ADDR_ORDER);
- init_free_seg_map(&mmap_state.sua.map, SZ_REVERSE_ADDR_ORDER);
+ init_free_seg_map(&mm->sa.map, SA_SZ_ADDR_ORDER);
+ init_free_seg_map(&mm->sua.map, SZ_REVERSE_ADDR_ORDER);
- mmap_state.supercarrier = 1;
- erts_have_erts_mmap |= ERTS_HAVE_ERTS_SUPERCARRIER_MMAP;
+ mm->supercarrier = 1;
- mmap_state.desc.new_area_hint = end;
+ mm->desc.new_area_hint = end;
}
#if !ERTS_HAVE_OS_MMAP
- mmap_state.no_os_mmap = 1;
+ mm->no_os_mmap = 1;
#endif
#ifdef HARD_DEBUG_MSEG
hard_dbg_mseg_init();
#endif
+
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ if (mm == &erts_literal_mmapper) {
+ erts_literals_start = erts_literal_mmapper.sa.bot;
+ erts_literals_size = erts_literal_mmapper.sua.top - erts_literals_start;
+ }
+#endif
+ is_first_call = 0;
}
@@ -2313,7 +2328,8 @@ add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2)
*lp = erts_bld_cons(hpp, szp, erts_bld_tuple(hpp, szp, 2, el1, el2), *lp);
}
-Eterm erts_mmap_info(int *print_to_p,
+Eterm erts_mmap_info(ErtsMemMapper* mm,
+ int *print_to_p,
void *print_to_arg,
Eterm** hpp, Uint* szp,
struct erts_mmap_info_struct* emis)
@@ -2328,29 +2344,29 @@ Eterm erts_mmap_info(int *print_to_p,
Eterm res = THE_NON_VALUE;
if (!hpp) {
- erts_smp_mtx_lock(&mmap_state.mtx);
- emis->sizes[0] = mmap_state.size.supercarrier.total;
- emis->sizes[1] = mmap_state.sa.top - mmap_state.sa.bot;
- emis->sizes[2] = mmap_state.sua.top - mmap_state.sua.bot;
- emis->sizes[3] = mmap_state.size.supercarrier.used.total;
- emis->sizes[4] = mmap_state.size.supercarrier.used.sa;
- emis->sizes[5] = mmap_state.size.supercarrier.used.sua;
+ erts_smp_mtx_lock(&mm->mtx);
+ emis->sizes[0] = mm->size.supercarrier.total;
+ emis->sizes[1] = mm->sa.top - mm->sa.bot;
+ emis->sizes[2] = mm->sua.top - mm->sua.bot;
+ emis->sizes[3] = mm->size.supercarrier.used.total;
+ emis->sizes[4] = mm->size.supercarrier.used.sa;
+ emis->sizes[5] = mm->size.supercarrier.used.sua;
- emis->segs[0] = mmap_state.no.free_segs.curr;
- emis->segs[1] = mmap_state.no.free_segs.max;
- emis->segs[2] = mmap_state.no.free_seg_descs;
- emis->segs[3] = mmap_state.desc.reserved;
- emis->segs[4] = mmap_state.sa.map.nseg;
- emis->segs[5] = mmap_state.sua.map.nseg;
+ emis->segs[0] = mm->no.free_segs.curr;
+ emis->segs[1] = mm->no.free_segs.max;
+ emis->segs[2] = mm->no.free_seg_descs;
+ emis->segs[3] = mm->desc.reserved;
+ emis->segs[4] = mm->sa.map.nseg;
+ emis->segs[5] = mm->sua.map.nseg;
- emis->os_used = mmap_state.size.os.used;
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ emis->os_used = mm->size.os.used;
+ erts_smp_mtx_unlock(&mm->mtx);
}
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
const char* prefix = "supercarrier ";
erts_print(to, arg, "%stotal size: %bpu\n", prefix, emis->sizes[0]);
erts_print(to, arg, "%stotal sa size: %bpu\n", prefix, emis->sizes[1]);
@@ -2365,7 +2381,7 @@ Eterm erts_mmap_info(int *print_to_p,
erts_print(to, arg, "%ssa free segs: %bpu\n", prefix, emis->segs[4]);
erts_print(to, arg, "%ssua free segs: %bpu\n", prefix, emis->segs[5]);
}
- if (!mmap_state.no_os_mmap) {
+ if (!mm->no_os_mmap) {
erts_print(to, arg, "os mmap size used: %bpu\n", emis->os_used);
}
}
@@ -2377,7 +2393,7 @@ Eterm erts_mmap_info(int *print_to_p,
}
lix = 0;
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
group[0] = erts_bld_atom_uword_2tup_list(hpp, szp,
sizeof(size_tags)/sizeof(Eterm),
size_tags, emis->sizes);
@@ -2389,7 +2405,7 @@ Eterm erts_mmap_info(int *print_to_p,
lix++;
}
- if (!mmap_state.no_os_mmap) {
+ if (!mm->no_os_mmap) {
group[0] = erts_bld_atom_uword_2tup_list(hpp, szp,
1, &am.used, &emis->os_used);
list[lix] = erts_bld_2tup_list(hpp, szp, 1, group_tags, group);
@@ -2401,25 +2417,26 @@ Eterm erts_mmap_info(int *print_to_p,
return res;
}
-Eterm erts_mmap_info_options(char *prefix,
+Eterm erts_mmap_info_options(ErtsMemMapper* mm,
+ char *prefix,
int *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
{
- const UWord scs = mmap_state.sua.top - mmap_state.sa.bot;
- const Eterm sco = mmap_state.no_os_mmap ? am_true : am_false;
- const Eterm scrpm = (mmap_state.reserve_physical == reserve_noop) ? am_true : am_false;
+ const UWord scs = mm->sua.top - mm->sa.bot;
+ const Eterm sco = mm->no_os_mmap ? am_true : am_false;
+ const Eterm scrpm = (mm->reserve_physical == reserve_noop) ? am_true : am_false;
Eterm res = THE_NON_VALUE;
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
erts_print(to, arg, "%sscs: %bpu\n", prefix, scs);
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
erts_print(to, arg, "%ssco: %T\n", prefix, sco);
erts_print(to, arg, "%sscrpm: %T\n", prefix, scrpm);
- erts_print(to, arg, "%sscrfsd: %beu\n", prefix, mmap_state.desc.reserved);
+ erts_print(to, arg, "%sscrfsd: %beu\n", prefix, mm->desc.reserved);
}
}
@@ -2429,9 +2446,9 @@ Eterm erts_mmap_info_options(char *prefix,
}
res = NIL;
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
add_2tup(hpp, szp, &res, am.scrfsd,
- erts_bld_uint(hpp,szp, mmap_state.desc.reserved));
+ erts_bld_uint(hpp,szp, mm->desc.reserved));
add_2tup(hpp, szp, &res, am.scrpm, scrpm);
add_2tup(hpp, szp, &res, am.sco, sco);
}
@@ -2441,9 +2458,9 @@ Eterm erts_mmap_info_options(char *prefix,
}
-Eterm erts_mmap_debug_info(Process* p)
+Eterm erts_mmap_debug_info(ErtsMemMapper* mm, Process* p)
{
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
ERTS_DECL_AM(sabot);
ERTS_DECL_AM(satop);
ERTS_DECL_AM(suabot);
@@ -2453,18 +2470,17 @@ Eterm erts_mmap_debug_info(Process* p)
UWord values[4];
Eterm *hp, *hp_end;
Uint may_need;
- const Uint PTR_BIG_SZ = HALFWORD_HEAP ? 3 : 2;
-
- erts_smp_mtx_lock(&mmap_state.mtx);
- values[0] = (UWord)mmap_state.sa.bot;
- values[1] = (UWord)mmap_state.sa.top;
- values[2] = (UWord)mmap_state.sua.bot;
- values[3] = (UWord)mmap_state.sua.top;
- sa_list = build_free_seg_list(p, &mmap_state.sa.map);
- sua_list = build_free_seg_list(p, &mmap_state.sua.map);
- erts_smp_mtx_unlock(&mmap_state.mtx);
-
- may_need = 4*(2+3+PTR_BIG_SZ) + 2*(2+3);
+
+ erts_smp_mtx_lock(&mm->mtx);
+ values[0] = (UWord)mm->sa.bot;
+ values[1] = (UWord)mm->sa.top;
+ values[2] = (UWord)mm->sua.bot;
+ values[3] = (UWord)mm->sua.top;
+ sa_list = build_free_seg_list(p, &mm->sa.map);
+ sua_list = build_free_seg_list(p, &mm->sua.map);
+ erts_smp_mtx_unlock(&mm->mtx);
+
+ may_need = 4*(2+3+2) + 2*(2+3);
hp = HAlloc(p, may_need);
hp_end = hp + may_need;
diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h
index 66619c5161..61d912fd28 100644
--- a/erts/emulator/sys/common/erl_mmap.h
+++ b/erts/emulator/sys/common/erl_mmap.h
@@ -30,9 +30,6 @@
#define ERTS_MMAPFLG_SUPERCARRIER_ONLY (((Uint32) 1) << 1)
#define ERTS_MMAPFLG_SUPERALIGNED (((Uint32) 1) << 2)
-#define ERTS_HAVE_ERTS_OS_MMAP (1 << 0)
-#define ERTS_HAVE_ERTS_SUPERCARRIER_MMAP (1 << 1)
-extern int erts_have_erts_mmap;
extern UWord erts_page_inv_mask;
typedef struct {
@@ -53,23 +50,29 @@ typedef struct {
#define ERTS_MMAP_INIT_DEFAULT_INITER \
{{NULL, NULL}, {NULL, NULL}, 0, 1, (1 << 16), 1}
-void *erts_mmap(Uint32 flags, UWord *sizep);
-void erts_munmap(Uint32 flags, void *ptr, UWord size);
-void *erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep);
-int erts_mmap_in_supercarrier(void *ptr);
-void erts_mmap_init(ErtsMMapInit*);
+#define ERTS_MMAP_INIT_LITERAL_INITER \
+ {{NULL, NULL}, {NULL, NULL}, 1024*1024*1024, 1, (1 << 16), 0}
+
+typedef struct ErtsMemMapper_ ErtsMemMapper;
+
+void *erts_mmap(ErtsMemMapper*, Uint32 flags, UWord *sizep);
+void erts_munmap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord size);
+void *erts_mremap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord old_size, UWord *sizep);
+int erts_mmap_in_supercarrier(ErtsMemMapper*, void *ptr);
+void erts_mmap_init(ErtsMemMapper*, ErtsMMapInit*);
struct erts_mmap_info_struct
{
UWord sizes[6];
UWord segs[6];
UWord os_used;
};
-Eterm erts_mmap_info(int *print_to_p, void *print_to_arg,
+Eterm erts_mmap_info(ErtsMemMapper*, int *print_to_p, void *print_to_arg,
Eterm** hpp, Uint* szp, struct erts_mmap_info_struct*);
-Eterm erts_mmap_info_options(char *prefix, int *print_to_p, void *print_to_arg,
+Eterm erts_mmap_info_options(ErtsMemMapper*,
+ char *prefix, int *print_to_p, void *print_to_arg,
Uint **hpp, Uint *szp);
struct process;
-Eterm erts_mmap_debug_info(struct process*);
+Eterm erts_mmap_debug_info(ErtsMemMapper*, struct process*);
#define ERTS_SUPERALIGNED_SIZE \
(1 << ERTS_MMAP_SUPERALIGNED_BITS)
@@ -121,6 +124,11 @@ Eterm erts_mmap_debug_info(struct process*);
# define ERTS_HAVE_OS_MMAP 1
#endif
+extern ErtsMemMapper erts_dflt_mmapper;
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+extern ErtsMemMapper erts_literal_mmapper;
+#endif
+
/*#define HARD_DEBUG_MSEG*/
#ifdef HARD_DEBUG_MSEG
# define HARD_DBG_INSERT_MSEG hard_dbg_insert_mseg
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index 0d51aad863..20695899eb 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -99,17 +99,12 @@ static const int debruijn[32] = {
static int atoms_initialized;
-typedef struct mem_kind_t MemKind;
-
const ErtsMsegOpt_t erts_mseg_default_opt = {
1, /* Use cache */
1, /* Preserv data */
0, /* Absolute shrink threshold */
0, /* Relative shrink threshold */
0 /* Scheduler specific */
-#if HALFWORD_HEAP
- ,0 /* need low memory */
-#endif
};
@@ -142,7 +137,14 @@ struct cache_t_ {
typedef struct ErtsMsegAllctr_t_ ErtsMsegAllctr_t;
-struct mem_kind_t {
+struct ErtsMsegAllctr_t_ {
+ int ix;
+
+ int is_init_done;
+ int is_thread_safe;
+ erts_mtx_t mtx;
+
+ int is_cache_check_scheduled;
cache_t cache[MAX_CACHE_SIZE];
cache_t cache_unpowered_node;
@@ -168,29 +170,6 @@ struct mem_kind_t {
} max_ever;
} segments;
- ErtsMsegAllctr_t *ma;
- const char* name;
- MemKind* next;
-};/*MemKind*/
-
-struct ErtsMsegAllctr_t_ {
- int ix;
-
- int is_init_done;
- int is_thread_safe;
- erts_mtx_t mtx;
-
- int is_cache_check_scheduled;
-
- MemKind* mk_list;
-
-#if HALFWORD_HEAP
- MemKind low_mem;
- MemKind hi_mem;
-#else
- MemKind the_mem;
-#endif
-
Uint max_cache_size;
Uint abs_max_cache_bad_fit;
Uint rel_max_cache_bad_fit;
@@ -302,22 +281,17 @@ schedule_cache_check(ErtsMsegAllctr_t *ma) {
/* #define ERTS_PRINT_ERTS_MMAP */
static ERTS_INLINE void *
-mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep)
+mseg_create(ErtsMsegAllctr_t *ma, Uint flags, UWord *sizep)
{
#ifdef ERTS_PRINT_ERTS_MMAP
UWord req_size = *sizep;
#endif
void *seg;
Uint32 mmap_flags = 0;
-#if HALFWORD_HEAP
- mmap_flags |= ((mk == &ma->low_mem)
- ? ERTS_MMAPFLG_SUPERCARRIER_ONLY
- : ERTS_MMAPFLG_OS_ONLY);
-#endif
if (MSEG_FLG_IS_2POW(flags))
mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
- seg = erts_mmap(mmap_flags, sizep);
+ seg = erts_mmap(&erts_dflt_mmapper, mmap_flags, sizep);
#ifdef ERTS_PRINT_ERTS_MMAP
erts_fprintf(stderr, "%p = erts_mmap(%s, {%bpu, %bpu});\n", seg,
@@ -331,18 +305,13 @@ mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep)
}
static ERTS_INLINE void
-mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord size) {
+mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, void *seg_p, UWord size) {
Uint32 mmap_flags = 0;
-#if HALFWORD_HEAP
- mmap_flags |= ((mk == &ma->low_mem)
- ? ERTS_MMAPFLG_SUPERCARRIER_ONLY
- : ERTS_MMAPFLG_OS_ONLY);
-#endif
if (MSEG_FLG_IS_2POW(flags))
mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
- erts_munmap(mmap_flags, seg_p, size);
+ erts_munmap(&erts_dflt_mmapper, mmap_flags, seg_p, size);
#ifdef ERTS_PRINT_ERTS_MMAP
erts_fprintf(stderr, "erts_munmap(%s, %p, %bpu);\n",
(mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua",
@@ -353,22 +322,17 @@ mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord s
}
static ERTS_INLINE void *
-mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *old_seg, UWord old_size, UWord *sizep)
+mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, void *old_seg, UWord old_size, UWord *sizep)
{
#ifdef ERTS_PRINT_ERTS_MMAP
UWord req_size = *sizep;
#endif
void *new_seg;
Uint32 mmap_flags = 0;
-#if HALFWORD_HEAP
- mmap_flags |= ((mk == &ma->low_mem)
- ? ERTS_MMAPFLG_SUPERCARRIER_ONLY
- : ERTS_MMAPFLG_OS_ONLY);
-#endif
if (MSEG_FLG_IS_2POW(flags))
mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
- new_seg = erts_mremap(mmap_flags, old_seg, old_size, sizep);
+ new_seg = erts_mremap(&erts_dflt_mmapper, mmap_flags, old_seg, old_size, sizep);
#ifdef ERTS_PRINT_ERTS_MMAP
erts_fprintf(stderr, "%p = erts_mremap(%s, %p, %bpu, {%bpu, %bpu});\n",
@@ -392,11 +356,8 @@ do { \
|| erts_smp_thr_progress_is_blocking() \
|| ERTS_IS_CRASH_DUMPING); \
} while (0)
-#define ERTS_DBG_MK_CHK_THR_ACCESS(MK) \
- ERTS_DBG_MA_CHK_THR_ACCESS((MK)->ma)
#else
#define ERTS_DBG_MA_CHK_THR_ACCESS(MA)
-#define ERTS_DBG_MK_CHK_THR_ACCESS(MK)
#endif
/* Cache interface */
@@ -409,10 +370,10 @@ static ERTS_INLINE void mseg_cache_clear_node(cache_t *c) {
c->prev = c;
}
-static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, Uint flags) {
+static ERTS_INLINE int cache_bless_segment(ErtsMsegAllctr_t *ma, void *seg, UWord size, Uint flags) {
cache_t *c;
- ERTS_DBG_MK_CHK_THR_ACCESS(mk);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
ASSERT(!MSEG_FLG_IS_2POW(flags) || (MSEG_FLG_IS_2POW(flags) && MAP_IS_ALIGNED(seg) && IS_2POW(size)));
@@ -421,11 +382,11 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U
* Large blocks has no such cache and it is up to mseg to cache them to speed things up.
*/
- if (!erts_circleq_is_empty(&(mk->cache_free))) {
+ if (!erts_circleq_is_empty(&(ma->cache_free))) {
/* We have free slots, use one to cache the segment */
- c = erts_circleq_head(&(mk->cache_free));
+ c = erts_circleq_head(&(ma->cache_free));
erts_circleq_remove(c);
c->seg = seg;
@@ -437,29 +398,28 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U
ASSERT(ix < CACHE_AREAS);
ASSERT((1 << (ix + MSEG_ALIGN_BITS)) == size);
- erts_circleq_push_head(&(mk->cache_powered_node[ix]), c);
+ erts_circleq_push_head(&(ma->cache_powered_node[ix]), c);
} else
- erts_circleq_push_head(&(mk->cache_unpowered_node), c);
+ erts_circleq_push_head(&(ma->cache_unpowered_node), c);
- mk->cache_size++;
- ASSERT(mk->cache_size <= mk->ma->max_cache_size);
+ ma->cache_size++;
return 1;
- } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(mk->cache_unpowered_node))) {
+ } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(ma->cache_unpowered_node))) {
/* No free slots.
* Evict oldest slot from unpowered cache so we can cache an unpowered (sbc) segment */
- c = erts_circleq_tail(&(mk->cache_unpowered_node));
+ c = erts_circleq_tail(&(ma->cache_unpowered_node));
erts_circleq_remove(c);
- mseg_destroy(mk->ma, ERTS_MSEG_FLG_NONE, mk, c->seg, c->size);
+ mseg_destroy(ma, ERTS_MSEG_FLG_NONE, c->seg, c->size);
mseg_cache_clear_node(c);
c->seg = seg;
c->size = size;
- erts_circleq_push_head(&(mk->cache_unpowered_node), c);
+ erts_circleq_push_head(&(ma->cache_unpowered_node), c);
return 1;
} else if (!MSEG_FLG_IS_2POW(flags)) {
@@ -473,20 +433,20 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U
int i;
for( i = 0; i < CACHE_AREAS; i++) {
- if (erts_circleq_is_empty(&(mk->cache_powered_node[i])))
+ if (erts_circleq_is_empty(&(ma->cache_powered_node[i])))
continue;
- c = erts_circleq_tail(&(mk->cache_powered_node[i]));
+ c = erts_circleq_tail(&(ma->cache_powered_node[i]));
erts_circleq_remove(c);
- mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, c->seg, c->size);
+ mseg_destroy(ma, ERTS_MSEG_FLG_2POW, c->seg, c->size);
mseg_cache_clear_node(c);
c->seg = seg;
c->size = size;
- erts_circleq_push_head(&(mk->cache_unpowered_node), c);
+ erts_circleq_push_head(&(ma->cache_unpowered_node), c);
return 1;
}
@@ -495,11 +455,11 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U
return 0;
}
-static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flags) {
+static ERTS_INLINE void *cache_get_segment(ErtsMsegAllctr_t *ma, UWord *size_p, Uint flags) {
UWord size = *size_p;
- ERTS_DBG_MK_CHK_THR_ACCESS(mk);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
if (MSEG_FLG_IS_2POW(flags)) {
@@ -512,10 +472,10 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
for( i = ix; i < CACHE_AREAS; i++) {
- if (erts_circleq_is_empty(&(mk->cache_powered_node[i])))
+ if (erts_circleq_is_empty(&(ma->cache_powered_node[i])))
continue;
- c = erts_circleq_head(&(mk->cache_powered_node[i]));
+ c = erts_circleq_head(&(ma->cache_powered_node[i]));
erts_circleq_remove(c);
ASSERT(IS_2POW(c->size));
@@ -524,31 +484,31 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
csize = c->size;
seg = (char*) c->seg;
- mk->cache_size--;
- mk->cache_hits++;
+ ma->cache_size--;
+ ma->cache_hits++;
/* link to free cache list */
mseg_cache_clear_node(c);
- erts_circleq_push_head(&(mk->cache_free), c);
+ erts_circleq_push_head(&(ma->cache_free), c);
- ASSERT(!(mk->cache_size < 0));
+ ASSERT(!(ma->cache_size < 0));
if (csize != size)
- mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, seg + size, csize - size);
+ mseg_destroy(ma, ERTS_MSEG_FLG_2POW, seg + size, csize - size);
return seg;
}
}
- else if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) {
+ else if (!erts_circleq_is_empty(&(ma->cache_unpowered_node))) {
void *seg;
cache_t *c;
cache_t *best = NULL;
UWord bdiff = 0;
UWord csize;
- UWord bad_max_abs = mk->ma->abs_max_cache_bad_fit;
- UWord bad_max_rel = mk->ma->rel_max_cache_bad_fit;
+ UWord bad_max_abs = ma->abs_max_cache_bad_fit;
+ UWord bad_max_rel = ma->rel_max_cache_bad_fit;
- erts_circleq_foreach(c, &(mk->cache_unpowered_node)) {
+ erts_circleq_foreach(c, &(ma->cache_unpowered_node)) {
csize = c->size;
if (csize >= size) {
if (((csize - size)*100 < bad_max_rel*size) && (csize - size) < bad_max_abs ) {
@@ -557,11 +517,11 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
erts_circleq_remove(c);
- mk->cache_size--;
- mk->cache_hits++;
+ ma->cache_size--;
+ ma->cache_hits++;
mseg_cache_clear_node(c);
- erts_circleq_push_head(&(mk->cache_free), c);
+ erts_circleq_push_head(&(ma->cache_free), c);
*size_p = csize;
@@ -584,7 +544,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
ASSERT(best->seg);
ASSERT(best->size > 0);
- mk->cache_hits++;
+ ma->cache_hits++;
/* Use current cache placement for remaining segment space */
@@ -608,7 +568,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
* using callbacks from aux-work in the scheduler.
*/
-static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) {
+static ERTS_INLINE Uint mseg_drop_one_cache_size(ErtsMsegAllctr_t *ma, Uint flags, cache_t *head) {
cache_t *c = NULL;
c = erts_circleq_tail(head);
@@ -617,19 +577,19 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg);
- mseg_destroy(mk->ma, flags, mk, c->seg, c->size);
+ mseg_destroy(ma, flags, c->seg, c->size);
mseg_cache_clear_node(c);
- erts_circleq_push_head(&(mk->cache_free), c);
+ erts_circleq_push_head(&(ma->cache_free), c);
- mk->segments.current.watermark--;
- mk->cache_size--;
+ ma->segments.current.watermark--;
+ ma->cache_size--;
- ASSERT( mk->cache_size >= 0 );
+ ASSERT(ma->cache_size >= 0);
- return mk->cache_size;
+ return ma->cache_size;
}
-static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) {
+static ERTS_INLINE Uint mseg_drop_cache_size(ErtsMsegAllctr_t *ma, Uint flags, cache_t *head) {
cache_t *c = NULL;
while (!erts_circleq_is_empty(head)) {
@@ -640,58 +600,52 @@ static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, ca
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg);
- mseg_destroy(mk->ma, flags, mk, c->seg, c->size);
+ mseg_destroy(ma, flags, c->seg, c->size);
mseg_cache_clear_node(c);
- erts_circleq_push_head(&(mk->cache_free), c);
-
- mk->segments.current.watermark--;
- mk->cache_size--;
+ erts_circleq_push_head(&(ma->cache_free), c);
+ ma->segments.current.watermark--;
+ ma->cache_size--;
}
- ASSERT( mk->cache_size >= 0 );
+ ASSERT(ma->cache_size >= 0);
- return mk->cache_size;
+ return ma->cache_size;
}
-/* mseg_check_memkind_cache
- * - Check if we can empty some cached segments in this
- * MemKind.
+/* mseg_check_cache
+ * - Check if we can empty some cached segments in this allocator
*/
-static Uint mseg_check_memkind_cache(MemKind *mk) {
+static Uint mseg_check_cache(ErtsMsegAllctr_t *ma) {
int i;
- ERTS_DBG_MK_CHK_THR_ACCESS(mk);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
for (i = 0; i < CACHE_AREAS; i++) {
- if (!erts_circleq_is_empty(&(mk->cache_powered_node[i])))
- return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i]));
+ if (!erts_circleq_is_empty(&(ma->cache_powered_node[i])))
+ return mseg_drop_one_cache_size(ma, ERTS_MSEG_FLG_2POW, &(ma->cache_powered_node[i]));
}
- if (!erts_circleq_is_empty(&(mk->cache_unpowered_node)))
- return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node));
+ if (!erts_circleq_is_empty(&(ma->cache_unpowered_node)))
+ return mseg_drop_one_cache_size(ma, ERTS_MSEG_FLG_NONE, &(ma->cache_unpowered_node));
return 0;
}
/* mseg_cache_check
* - Check if we have some cache we can purge
- * in any of the memkinds.
*/
static void mseg_cache_check(ErtsMsegAllctr_t *ma) {
- MemKind* mk;
Uint empty_cache = 1;
ERTS_MSEG_LOCK(ma);
- for (mk = ma->mk_list; mk; mk = mk->next) {
- if (mseg_check_memkind_cache(mk))
- empty_cache = 0;
- }
+ if (mseg_check_cache(ma))
+ empty_cache = 0;
/* If all MemKinds caches are empty,
* remove aux-work callback
@@ -709,7 +663,7 @@ static void mseg_cache_check(ErtsMsegAllctr_t *ma) {
/* erts_mseg_cache_check
* - This is a callback that is scheduled as aux-work from
* schedulers and is called at some interval if we have a cache
- * on this mseg-allocator and memkind.
+ * on this mseg-allocator.
* - Purpose: Empty cache slowly so we don't collect mapped areas
* and bloat memory.
*/
@@ -719,42 +673,32 @@ void erts_mseg_cache_check(void) {
}
-/* *_mseg_clear_*_cache
+/* mseg_clear_cache
* Remove cached segments from the allocator completely
*/
-static void mseg_clear_memkind_cache(MemKind *mk) {
+
+static void mseg_clear_cache(ErtsMsegAllctr_t *ma) {
int i;
+ ERTS_MSEG_LOCK(ma);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
/* drop pow2 caches */
for (i = 0; i < CACHE_AREAS; i++) {
- if (erts_circleq_is_empty(&(mk->cache_powered_node[i])))
+ if (erts_circleq_is_empty(&(ma->cache_powered_node[i])))
continue;
- mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i]));
- ASSERT(erts_circleq_is_empty(&(mk->cache_powered_node[i])));
+ mseg_drop_cache_size(ma, ERTS_MSEG_FLG_2POW, &(ma->cache_powered_node[i]));
+ ASSERT(erts_circleq_is_empty(&(ma->cache_powered_node[i])));
}
/* drop varied caches */
- if (!erts_circleq_is_empty(&(mk->cache_unpowered_node)))
- mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node));
-
- ASSERT(erts_circleq_is_empty(&(mk->cache_unpowered_node)));
- ASSERT(mk->cache_size == 0);
-}
-
-static void mseg_clear_cache(ErtsMsegAllctr_t *ma) {
- MemKind* mk;
-
- ERTS_MSEG_LOCK(ma);
- ERTS_DBG_MA_CHK_THR_ACCESS(ma);
+ if (!erts_circleq_is_empty(&(ma->cache_unpowered_node)))
+ mseg_drop_cache_size(ma, ERTS_MSEG_FLG_NONE, &(ma->cache_unpowered_node));
-
- for (mk = ma->mk_list; mk; mk = mk->next) {
- mseg_clear_memkind_cache(mk);
- }
+ ASSERT(erts_circleq_is_empty(&(ma->cache_unpowered_node)));
+ ASSERT(ma->cache_size == 0);
INC_CC(ma, clear_cache);
-
ERTS_MSEG_UNLOCK(ma);
}
@@ -763,25 +707,12 @@ void erts_mseg_clear_cache(void) {
mseg_clear_cache(ERTS_MSEG_ALLCTR_IX(0));
}
-
-
-static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma,
- const ErtsMsegOpt_t *opt)
-{
-#if HALFWORD_HEAP
- return opt->low_mem ? &ma->low_mem : &ma->hi_mem;
-#else
- return &ma->the_mem;
-#endif
-}
-
static void *
mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p,
Uint flags, const ErtsMsegOpt_t *opt)
{
UWord size;
void *seg;
- MemKind* mk = memkind(ma, opt);
INC_CC(ma, alloc);
@@ -795,10 +726,10 @@ mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p,
}
}
- if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size, flags)) != NULL)
+ if (opt->cache && ma->cache_size > 0 && (seg = cache_get_segment(ma, &size, flags)) != NULL)
goto done;
- seg = mseg_create(ma, flags, mk, &size);
+ seg = mseg_create(ma, flags, &size);
if (!seg)
*size_p = 0;
@@ -808,7 +739,7 @@ done:
if (erts_mtrace_enabled)
erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size);
- ERTS_MSEG_ALLOC_STAT(mk,size);
+ ERTS_MSEG_ALLOC_STAT(ma,size);
}
return seg;
@@ -819,11 +750,9 @@ static void
mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size,
Uint flags, const ErtsMsegOpt_t *opt)
{
- MemKind* mk = memkind(ma, opt);
+ ERTS_MSEG_DEALLOC_STAT(ma,size);
- ERTS_MSEG_DEALLOC_STAT(mk,size);
-
- if (opt->cache && cache_bless_segment(mk, seg, size, flags)) {
+ if (opt->cache && cache_bless_segment(ma, seg, size, flags)) {
schedule_cache_check(ma);
goto done;
}
@@ -831,7 +760,7 @@ mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size,
if (erts_mtrace_enabled)
erts_mtrace_crr_free(atype, SEGTYPE, seg);
- mseg_destroy(ma, flags, mk, seg, size);
+ mseg_destroy(ma, flags, seg, size);
done:
@@ -842,7 +771,6 @@ static void *
mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
UWord old_size, UWord *new_size_p, Uint flags, const ErtsMsegOpt_t *opt)
{
- MemKind* mk;
void *new_seg;
UWord new_size;
@@ -861,7 +789,6 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
return NULL;
}
- mk = memkind(ma, opt);
new_seg = seg;
if (!MSEG_FLG_IS_2POW(flags))
@@ -876,7 +803,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
if (new_size > old_size) {
if (opt->preserv) {
- new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size);
+ new_seg = mseg_recreate(ma, flags, (void *) seg, old_size, &new_size);
if (!new_seg)
new_size = old_size;
}
@@ -896,7 +823,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
new_size = old_size;
}
else {
- new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size);
+ new_seg = mseg_recreate(ma, flags, (void *) seg, old_size, &new_size);
if (!new_seg)
new_size = old_size;
}
@@ -910,7 +837,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
ASSERT(!MSEG_FLG_IS_2POW(flags) || IS_2POW(new_size));
*new_size_p = new_size;
- ERTS_MSEG_REALLOC_STAT(mk, old_size, new_size);
+ ERTS_MSEG_REALLOC_STAT(ma, old_size, new_size);
return new_seg;
}
@@ -1070,7 +997,8 @@ info_options(ErtsMsegAllctr_t *ma,
{
Eterm res;
- res = erts_mmap_info_options(prefix, print_to_p, print_to_arg, hpp, szp);
+ res = erts_mmap_info_options(&erts_dflt_mmapper,
+ prefix, print_to_p, print_to_arg, hpp, szp);
if (print_to_p) {
int to = *print_to_p;
@@ -1180,63 +1108,63 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp
}
static Eterm
-info_status(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg,
+info_status(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg,
int begin_new_max_period, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
- if (mk->segments.max_ever.no < mk->segments.max.no)
- mk->segments.max_ever.no = mk->segments.max.no;
- if (mk->segments.max_ever.sz < mk->segments.max.sz)
- mk->segments.max_ever.sz = mk->segments.max.sz;
+ if (ma->segments.max_ever.no < ma->segments.max.no)
+ ma->segments.max_ever.no = ma->segments.max.no;
+ if (ma->segments.max_ever.sz < ma->segments.max.sz)
+ ma->segments.max_ever.sz = ma->segments.max.sz;
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
- erts_print(to, arg, "cached_segments: %beu\n", mk->cache_size);
- erts_print(to, arg, "cache_hits: %beu\n", mk->cache_hits);
+ erts_print(to, arg, "cached_segments: %beu\n", ma->cache_size);
+ erts_print(to, arg, "cache_hits: %beu\n", ma->cache_hits);
erts_print(to, arg, "segments: %beu %beu %beu\n",
- mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no);
+ ma->segments.current.no, ma->segments.max.no, ma->segments.max_ever.no);
erts_print(to, arg, "segments_size: %beu %beu %beu\n",
- mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz);
+ ma->segments.current.sz, ma->segments.max.sz, ma->segments.max_ever.sz);
erts_print(to, arg, "segments_watermark: %beu\n",
- mk->segments.current.watermark);
+ ma->segments.current.watermark);
}
if (hpp || szp) {
res = NIL;
add_2tup(hpp, szp, &res,
am.segments_watermark,
- bld_unstable_uint(hpp, szp, mk->segments.current.watermark));
+ bld_unstable_uint(hpp, szp, ma->segments.current.watermark));
add_4tup(hpp, szp, &res,
am.segments_size,
- bld_unstable_uint(hpp, szp, mk->segments.current.sz),
- bld_unstable_uint(hpp, szp, mk->segments.max.sz),
- bld_unstable_uint(hpp, szp, mk->segments.max_ever.sz));
+ bld_unstable_uint(hpp, szp, ma->segments.current.sz),
+ bld_unstable_uint(hpp, szp, ma->segments.max.sz),
+ bld_unstable_uint(hpp, szp, ma->segments.max_ever.sz));
add_4tup(hpp, szp, &res,
am.segments,
- bld_unstable_uint(hpp, szp, mk->segments.current.no),
- bld_unstable_uint(hpp, szp, mk->segments.max.no),
- bld_unstable_uint(hpp, szp, mk->segments.max_ever.no));
+ bld_unstable_uint(hpp, szp, ma->segments.current.no),
+ bld_unstable_uint(hpp, szp, ma->segments.max.no),
+ bld_unstable_uint(hpp, szp, ma->segments.max_ever.no));
add_2tup(hpp, szp, &res,
am.cache_hits,
- bld_unstable_uint(hpp, szp, mk->cache_hits));
+ bld_unstable_uint(hpp, szp, ma->cache_hits));
add_2tup(hpp, szp, &res,
am.cached_segments,
- bld_unstable_uint(hpp, szp, mk->cache_size));
+ bld_unstable_uint(hpp, szp, ma->cache_size));
}
if (begin_new_max_period) {
- mk->segments.max.no = mk->segments.current.no;
- mk->segments.max.sz = mk->segments.current.sz;
+ ma->segments.max.no = ma->segments.current.no;
+ ma->segments.max.sz = ma->segments.current.sz;
}
return res;
}
-static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg,
+static Eterm info_memkind(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg,
int begin_max_per, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
@@ -1244,15 +1172,15 @@ static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, vo
Eterm values[3];
if (print_to_p) {
- erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", mk->name);
+ erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", "all memory");
}
if (hpp || szp) {
atoms[0] = am.name;
atoms[1] = am.status;
atoms[2] = am.calls;
- values[0] = erts_bld_string(hpp, szp, mk->name);
+ values[0] = erts_bld_string(hpp, szp, "all memory");
}
- values[1] = info_status(ma, mk, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+ values[1] = info_status(ma, print_to_p, print_to_arg, begin_max_per, hpp, szp);
values[2] = info_calls(ma, print_to_p, print_to_arg, hpp, szp);
if (hpp || szp)
@@ -1261,7 +1189,6 @@ static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, vo
return res;
}
-
static Eterm
info_version(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
{
@@ -1326,12 +1253,7 @@ erts_mseg_info(int ix,
ERTS_MSEG_LOCK(ma);
ERTS_DBG_MA_CHK_THR_ACCESS(ma);
-#if HALFWORD_HEAP
- values[n++] = info_memkind(ma, &ma->low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
- values[n++] = info_memkind(ma, &ma->hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
-#else
- values[n++] = info_memkind(ma, &ma->the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
-#endif
+ values[n++] = info_memkind(ma, print_to_p, print_to_arg, begin_max_per, hpp, szp);
if (hpp || szp)
res = bld_2tup_list(hpp, szp, n, atoms, values);
@@ -1408,13 +1330,10 @@ Uint
erts_mseg_no(const ErtsMsegOpt_t *opt)
{
ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt);
- MemKind* mk;
- Uint n = 0;
+ Uint n;
ERTS_MSEG_LOCK(ma);
ERTS_DBG_MA_CHK_THR_ACCESS(ma);
- for (mk=ma->mk_list; mk; mk=mk->next) {
- n += mk->segments.current.no;
- }
+ n = ma->segments.current.no;
ERTS_MSEG_UNLOCK(ma);
return n;
}
@@ -1426,16 +1345,16 @@ erts_mseg_unit_size(void)
}
-static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name)
+static void mem_cache_init(ErtsMsegAllctr_t *ma)
{
int i;
/* Clear all cache headers */
- mseg_cache_clear_node(&(mk->cache_free));
- mseg_cache_clear_node(&(mk->cache_unpowered_node));
+ mseg_cache_clear_node(&(ma->cache_free));
+ mseg_cache_clear_node(&(ma->cache_unpowered_node));
for (i = 0; i < CACHE_AREAS; i++) {
- mseg_cache_clear_node(&(mk->cache_powered_node[i]));
+ mseg_cache_clear_node(&(ma->cache_powered_node[i]));
}
/* Populate cache free list */
@@ -1443,25 +1362,20 @@ static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name)
ASSERT(ma->max_cache_size <= MAX_CACHE_SIZE);
for (i = 0; i < ma->max_cache_size; i++) {
- mseg_cache_clear_node(&(mk->cache[i]));
- erts_circleq_push_head(&(mk->cache_free), &(mk->cache[i]));
+ mseg_cache_clear_node(&(ma->cache[i]));
+ erts_circleq_push_head(&(ma->cache_free), &(ma->cache[i]));
}
- mk->cache_size = 0;
- mk->cache_hits = 0;
-
- mk->segments.current.watermark = 0;
- mk->segments.current.no = 0;
- mk->segments.current.sz = 0;
- mk->segments.max.no = 0;
- mk->segments.max.sz = 0;
- mk->segments.max_ever.no = 0;
- mk->segments.max_ever.sz = 0;
-
- mk->ma = ma;
- mk->name = name;
- mk->next = ma->mk_list;
- ma->mk_list = mk;
+ ma->cache_size = 0;
+ ma->cache_hits = 0;
+
+ ma->segments.current.watermark = 0;
+ ma->segments.current.no = 0;
+ ma->segments.current.sz = 0;
+ ma->segments.max.no = 0;
+ ma->segments.max.sz = 0;
+ ma->segments.max_ever.no = 0;
+ ma->segments.max_ever.sz = 0;
}
void
@@ -1488,16 +1402,7 @@ erts_mseg_init(ErtsMsegInit_t *init)
erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms");
-#if HALFWORD_HEAP
- if (sizeof(void *) != 8)
- erl_exit(-1,"Halfword emulator cannot be run in 32bit mode");
-
- init->mmap.virtual_range.start = (char *) sbrk(0);
- init->mmap.virtual_range.end = (char *) 0x100000000UL;
- init->mmap.sco = 0;
-#endif
-
- erts_mmap_init(&init->mmap);
+ erts_mmap_init(&erts_dflt_mmapper, &init->dflt_mmap);
if (!IS_2POW(GET_PAGE_SIZE))
erl_exit(ERTS_ABORT_EXIT, "erts_mseg: Unexpected page_size %beu\n", GET_PAGE_SIZE);
@@ -1529,14 +1434,7 @@ erts_mseg_init(ErtsMsegInit_t *init)
if (ma->max_cache_size > MAX_CACHE_SIZE)
ma->max_cache_size = MAX_CACHE_SIZE;
- ma->mk_list = NULL;
-
-#if HALFWORD_HEAP
- mem_kind_init(ma, &ma->low_mem, "low memory");
- mem_kind_init(ma, &ma->hi_mem, "high memory");
-#else
- mem_kind_init(ma, &ma->the_mem, "all memory");
-#endif
+ mem_cache_init(ma);
sys_memzero((void *) &ma->calls, sizeof(ErtsMsegCalls));
}
@@ -1545,13 +1443,8 @@ erts_mseg_init(ErtsMsegInit_t *init)
static ERTS_INLINE Uint tot_cache_size(ErtsMsegAllctr_t *ma)
{
- MemKind* mk;
- Uint sz = 0;
ERTS_DBG_MA_CHK_THR_ACCESS(ma);
- for (mk=ma->mk_list; mk; mk=mk->next) {
- sz += mk->cache_size;
- }
- return sz;
+ return ma->cache_size;
}
/*
diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h
index ba04e919fc..2acd8f8505 100644
--- a/erts/emulator/sys/common/erl_mseg.h
+++ b/erts/emulator/sys/common/erl_mseg.h
@@ -42,16 +42,6 @@
#if ERTS_HAVE_MSEG_SUPER_ALIGNED
# define MSEG_ALIGN_BITS ERTS_MMAP_SUPERALIGNED_BITS
-#else
-/* If we don't use super aligned multiblock carriers
- * we will mmap with page size alignment (and thus use corresponding
- * align bits).
- *
- * Current implementation needs this to be a constant and
- * only uses this for user dev testing so setting page size
- * to 4096 (12 bits) is fine.
- */
-# define MSEG_ALIGN_BITS (12)
#endif
#if HAVE_ERTS_MSEG
@@ -69,7 +59,8 @@ typedef struct {
Uint rmcbf;
Uint mcs;
Uint nos;
- ErtsMMapInit mmap;
+ ErtsMMapInit dflt_mmap;
+ ErtsMMapInit literal_mmap;
} ErtsMsegInit_t;
#define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \
@@ -78,7 +69,8 @@ typedef struct {
20, /* rmcbf: Relative max cache bad fit */ \
10, /* mcs: Max cache size */ \
1000, /* cci: Cache check interval */ \
- ERTS_MMAP_INIT_DEFAULT_INITER \
+ ERTS_MMAP_INIT_DEFAULT_INITER, \
+ ERTS_MMAP_INIT_LITERAL_INITER \
}
typedef struct {
@@ -87,9 +79,6 @@ typedef struct {
UWord abs_shrink_th;
UWord rel_shrink_th;
int sched_spec;
-#if HALFWORD_HEAP
- int low_mem;
-#endif
} ErtsMsegOpt_t;
extern const ErtsMsegOpt_t erts_mseg_default_opt;
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index 21fa214364..36ee94111c 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -74,6 +74,7 @@
#include "erl_thr_progress.h"
#include "erl_driver.h"
#include "erl_alloc.h"
+#include "erl_msacc.h"
#if !defined(ERTS_POLL_USE_EPOLL) \
&& !defined(ERTS_POLL_USE_DEVPOLL) \
@@ -2238,6 +2239,7 @@ static ERTS_INLINE int
check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
{
int res;
+ ERTS_MSACC_PUSH_STATE_M();
if (erts_smp_atomic_read_nob(&ps->no_of_user_fds) == 0
&& timeout_time == ERTS_POLL_NO_TIMEOUT) {
/* Nothing to poll and zero timeout; done... */
@@ -2259,6 +2261,7 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
#ifdef ERTS_SMP
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
timerfd_set(ps, &its);
res = epoll_wait(ps->kp_fd, ps->res_events, max_res, -1);
res = timerfd_clear(ps, res, max_res);
@@ -2268,10 +2271,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
}
#else /* !ERTS_POLL_USE_TIMERFD */
timeout = (int) get_timeout(ps, 1000, timeout_time);
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = epoll_wait(ps->kp_fd, ps->res_events, max_res, timeout);
#endif /* !ERTS_POLL_USE_TIMERFD */
#elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */
@@ -2279,10 +2284,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
if (max_res > ps->res_events_len)
grow_res_events(ps, max_res);
timeout = get_timeout_timespec(ps, &ts, timeout_time);
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts);
#endif /* ----------------------------------------- */
}
@@ -2306,26 +2313,33 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
if (poll_res.dp_nfds > ps->res_events_len)
grow_res_events(ps, poll_res.dp_nfds);
poll_res.dp_fds = ps->res_events;
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
poll_res.dp_timeout = timeout;
res = ioctl(ps->kp_fd, DP_POLL, &poll_res);
#elif ERTS_POLL_USE_POLL && defined(HAVE_PPOLL) /* --- ppoll ---------------- */
struct timespec ts;
timeout = get_timeout_timespec(ps, &ts, timeout_time);
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = ppoll(ps->poll_fds, ps->no_poll_fds, &ts, NULL);
#elif ERTS_POLL_USE_POLL /* --- poll --------------------------------- */
timeout = (int) get_timeout(ps, 1000, timeout_time);
+
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = poll(ps->poll_fds, ps->no_poll_fds, timeout);
#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */
SysTimeval to;
@@ -2334,18 +2348,22 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
ERTS_FD_COPY(&ps->input_fds, &ps->res_input_fds);
ERTS_FD_COPY(&ps->output_fds, &ps->res_output_fds);
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = ERTS_SELECT(ps->max_fd + 1,
&ps->res_input_fds,
&ps->res_output_fds,
NULL,
&to);
#ifdef ERTS_SMP
- if (timeout)
+ if (timeout) {
erts_thr_progress_finalize_wait(NULL);
+ ERTS_MSACC_POP_STATE_M();
+ }
if (res < 0
&& errno == EBADF
&& ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) {
@@ -2380,10 +2398,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
return res;
#endif /* ----------------------------------------- */
}
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_finalize_wait(NULL);
#endif
+ ERTS_MSACC_POP_STATE_M();
+ }
return res;
}
}
diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h
index bd3a46ef0f..bc2c681876 100644
--- a/erts/emulator/sys/common/erl_poll.h
+++ b/erts/emulator/sys/common/erl_poll.h
@@ -93,7 +93,7 @@
# if defined(ERTS_USE_POLL)
# undef ERTS_POLL_USE_POLL
# define ERTS_POLL_USE_POLL 1
-# elif !defined(__WIN32__) && !defined(__OSE__)
+# elif !defined(__WIN32__)
# undef ERTS_POLL_USE_SELECT
# define ERTS_POLL_USE_SELECT 1
# endif
@@ -104,31 +104,13 @@
typedef Uint32 ErtsPollEvents;
#undef ERTS_POLL_EV_E2N
-#if defined(__WIN32__) || defined(__OSE__) /* --- win32 or ose -------- */
+#if defined(__WIN32__) /* --- win32 --------------------------------------- */
#define ERTS_POLL_EV_IN 1
#define ERTS_POLL_EV_OUT 2
#define ERTS_POLL_EV_ERR 4
#define ERTS_POLL_EV_NVAL 8
-#ifdef __OSE__
-
-typedef struct ErtsPollOseMsgList_ {
- struct ErtsPollOseMsgList_ *next;
- union SIGNAL *data;
-} ErtsPollOseMsgList;
-
-struct erts_sys_fd_type {
- SIGSELECT signo;
- ErlDrvOseEventId id;
- ErtsPollOseMsgList *msgs;
- ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig);
- ethr_mutex mtx;
- void *extra;
-};
-
-#endif
-
#elif ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */
#include <sys/epoll.h>
diff --git a/erts/emulator/sys/ose/beam.lmconf b/erts/emulator/sys/ose/beam.lmconf
deleted file mode 100644
index 4ad46b01d9..0000000000
--- a/erts/emulator/sys/ose/beam.lmconf
+++ /dev/null
@@ -1,26 +0,0 @@
-OSE_LM_STACK_SIZES=256,512,1024,2048,4096,8192,16384,65536
-OSE_LM_SIGNAL_SIZES=31,63,127,255,1023,4095,16383,65535
-OSE_LM_POOL_SIZE=0x200000
-OSE_LM_MAIN_NAME=main
-OSE_LM_MAIN_STACK_SIZE=0xF000
-OSE_LM_MAIN_PRIORITY=20
-## Has to be of a type that allows MAM
-OSE_LM_PROGRAM_TYPE=APP_RAM
-OSE_LM_DATA_INIT=YES
-OSE_LM_BSS_INIT=YES
-OSE_LM_EXEC_MODEL=SHARED
-HEAP_MAX_SIZE=1000000000
-HEAP_SMALL_BUF_INIT_SIZE=20971520
-HEAP_LARGE_BUF_THRESHOLD=16000000
-HEAP_LOCK_TYPE=2
-
-ERTS_DEFAULT_PRIO=24
-ERTS_SCHEDULER_PRIO=24
-ERTS_ASYNC_PRIO=22
-ERTS_AUX_PRIO=24
-ERTS_SYS_MSG_DISPATCHER_PRIO=21
-
-# Setting the environment variable EFS_RESOLVE_TMO on the block to 0.
-# This will eliminiate delays when trying to open files on not mounted
-# volumes.
-EFS_RESOLVE_TMO=0
diff --git a/erts/emulator/sys/ose/driver_int.h b/erts/emulator/sys/ose/driver_int.h
deleted file mode 100644
index 4a5b7171d1..0000000000
--- a/erts/emulator/sys/ose/driver_int.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * System dependant driver declarations
- */
-
-#ifndef __DRIVER_INT_H__
-#define __DRIVER_INT_H__
-
-#ifdef HAVE_SYS_UIO_H
-#include <sys/types.h>
-#include <sys/uio.h>
-
-typedef struct iovec SysIOVec;
-
-#else
-
-typedef struct {
- char* iov_base;
- int iov_len;
-} SysIOVec;
-
-#endif
-
-#endif
diff --git a/erts/emulator/sys/ose/erl_main.c b/erts/emulator/sys/ose/erl_main.c
deleted file mode 100644
index 877e85f43a..0000000000
--- a/erts/emulator/sys/ose/erl_main.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2000-2009. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-#include <stdlib.h>
-
-#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
-#include "ose.h"
-
-int
-main(int argc, char **argv) {
-
- (void)stdin;(void)stdout;(void)stderr;
-
- /* When starting using pm_create -c ARGV="-- -root ..", argv[0] is the first
- part of ARGV and not the name of the executable. So we shuffle some
- pointers here to make erl_start happy. */
- if (argv[0][0] == '-') {
- int i;
- char **tmp_argv = malloc(sizeof(char*)*(argc+1));
- for (i = 0; i < argc; i++)
- tmp_argv[i+1] = argv[i];
- tmp_argv[0] = "beam";
- erl_start(argc+1,tmp_argv);
- free(tmp_argv);
- } else {
- erl_start(argc,argv);
- }
-
- stop(current_process());
-
- return 0;
-}
diff --git a/erts/emulator/sys/ose/erl_ose_sys.h b/erts/emulator/sys/ose/erl_ose_sys.h
deleted file mode 100644
index d0cd3180bf..0000000000
--- a/erts/emulator/sys/ose/erl_ose_sys.h
+++ /dev/null
@@ -1,356 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2011. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- * This file handles differences between different Unix systems.
- * This should be the only place with conditional compilation
- * depending on the type of OS.
- */
-
-#ifndef _ERL_OSE_SYS_H
-#define _ERL_OSE_SYS_H
-
-#include "ose.h"
-#undef NIL
-#include "ramlog.h"
-#include "erts.sig"
-
-#include "fcntl.h"
-#include "math.h"
-#include "stdio.h"
-#include "stdlib.h"
-#include "string.h"
-#include "sys/param.h"
-#include "sys/time.h"
-#include "time.h"
-#include "dirent.h"
-#include "ethread.h"
-
-/* FIXME: configuration options */
-#define ERTS_SCHED_MIN_SPIN 1
-#define ERTS_SCHED_ONLY_POLL_SCHED_1 1
-#define ERTS_SCHED_FAIR 1
-#define NO_SYSCONF 1
-#define OPEN_MAX FOPEN_MAX
-
-#define MAP_ANON MAP_ANONYMOUS
-
-#ifndef HAVE_MMAP
-# define HAVE_MMAP 0
-#endif
-
-#if HAVE_MMAP
-# include "sys/mman.h"
-#endif
-
-/*
- * Min number of async threads
- */
-#define ERTS_MIN_NO_OF_ASYNC_THREADS 1
-
-/*
- * Our own type of "FD's"
- */
-#define ERTS_SYS_FD_TYPE struct erts_sys_fd_type*
-#define NO_FSTAT_ON_SYS_FD_TYPE 1 /* They are signals, not files */
-
-#include "sys/stat.h"
-
-/* FIXME mremap is not defined in OSE - POSIX issue */
-extern void *mremap (void *__addr, size_t __old_len, size_t __new_len,
- int __flags, ...);
-
-/* FIXME: mremap constants */
-#define MREMAP_MAYMOVE 1
-#define MREMAP_FIXED 2
-
-typedef void *GETENV_STATE;
-
-/*
-** For the erl_timer_sup module.
-*/
-#define HAVE_GETHRTIME
-
-typedef long long SysHrTime;
-extern SysHrTime sys_gethrtime(void);
-
-void sys_init_hrtime(void);
-
-typedef time_t erts_time_t;
-
-typedef struct timeval SysTimeval;
-
-#define sys_gettimeofday(Arg) ((void) gettimeofday((Arg), NULL))
-
-typedef struct {
- clock_t tms_utime;
- clock_t tms_stime;
- clock_t tms_cutime;
- clock_t tms_cstime;
-} SysTimes;
-
-extern int erts_ticks_per_sec;
-
-#define SYS_CLK_TCK (erts_ticks_per_sec)
-
-extern clock_t sys_times(SysTimes *buffer);
-
-/* No use in having other resolutions than 1 Ms. */
-#define SYS_CLOCK_RESOLUTION 1
-
-#define erts_isfinite finite
-
-#ifdef NO_FPE_SIGNALS
-
-#define erts_get_current_fp_exception() NULL
-#ifdef ERTS_SMP
-#define erts_thread_init_fp_exception() do{}while(0)
-#endif
-# define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0)
-# define __ERTS_FP_ERROR(fpexnp, f, Action) if (!finite(f)) { Action; } else {}
-# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) __ERTS_FP_ERROR(fpexnp, f, Action)
-# define __ERTS_SAVE_FP_EXCEPTION(fpexnp)
-# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp)
-
-#define erts_sys_block_fpe() 0
-#define erts_sys_unblock_fpe(x) do{}while(0)
-
-#else /* !NO_FPE_SIGNALS */
-
-extern volatile unsigned long *erts_get_current_fp_exception(void);
-#ifdef ERTS_SMP
-extern void erts_thread_init_fp_exception(void);
-#endif
-# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
-# define erts_fwait(fpexnp,f) \
- __asm__ __volatile__("fwait" : "=m"(*(fpexnp)) : "m"(f))
-# elif (defined(__powerpc__) || defined(__ppc__)) && defined(__GNUC__)
-# define erts_fwait(fpexnp,f) \
- __asm__ __volatile__("" : "=m"(*(fpexnp)) : "fm"(f))
-# elif defined(__sparc__) && defined(__linux__) && defined(__GNUC__)
-# define erts_fwait(fpexnp,f) \
- __asm__ __volatile__("" : "=m"(*(fpexnp)) : "em"(f))
-# else
-# define erts_fwait(fpexnp,f) \
- __asm__ __volatile__("" : "=m"(*(fpexnp)) : "g"(f))
-# endif
-# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
- extern void erts_restore_fpu(void);
-# else
-# define erts_restore_fpu() /*empty*/
-# endif
-# if (!defined(__GNUC__) || \
- (__GNUC__ < 2) || \
- (__GNUC__ == 2 && __GNUC_MINOR < 96)) && \
- !defined(__builtin_expect)
-# define __builtin_expect(x, expected_value) (x)
-# endif
-static __inline__ int erts_check_fpe(volatile unsigned long *fp_exception, double f)
-{
- erts_fwait(fp_exception, f);
- if (__builtin_expect(*fp_exception == 0, 1))
- return 0;
- *fp_exception = 0;
- erts_restore_fpu();
- return 1;
-}
-# undef erts_fwait
-# undef erts_restore_fpu
-extern void erts_fp_check_init_error(volatile unsigned long *fp_exception);
-static __inline__ void __ERTS_FP_CHECK_INIT(volatile unsigned long *fp_exception)
-{
- if (__builtin_expect(*fp_exception == 0, 1))
- return;
- erts_fp_check_init_error(fp_exception);
-}
-# define __ERTS_FP_ERROR(fpexnp, f, Action) do { if (erts_check_fpe((fpexnp),(f))) { Action; } } while (0)
-# define __ERTS_SAVE_FP_EXCEPTION(fpexnp) unsigned long old_erl_fp_exception = *(fpexnp)
-# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) \
- do { *(fpexnp) = old_erl_fp_exception; } while (0)
- /* This is for library calls where we don't trust the external
- code to always throw floating-point exceptions on errors. */
-static __inline__ int erts_check_fpe_thorough(volatile unsigned long *fp_exception, double f)
-{
- return erts_check_fpe(fp_exception, f) || !finite(f);
-}
-# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) \
- do { if (erts_check_fpe_thorough((fpexnp),(f))) { Action; } } while (0)
-
-int erts_sys_block_fpe(void);
-void erts_sys_unblock_fpe(int);
-
-#endif /* !NO_FPE_SIGNALS */
-
-#define ERTS_FP_CHECK_INIT(p) __ERTS_FP_CHECK_INIT(&(p)->fp_exception)
-#define ERTS_FP_ERROR(p, f, A) __ERTS_FP_ERROR(&(p)->fp_exception, f, A)
-#define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A)
-
-/* FIXME: force HAVE_GETPAGESIZE and stub getpagesize */
-#ifndef HAVE_GETPAGESIZE
-#define HAVE_GETPAGESIZE 1
-#endif
-
-extern int getpagesize(void);
-
-#ifndef HZ
-#define HZ 60
-#endif
-
-/* OSE5 doesn't provide limits.h so a number of macros should be
- * added manually */
-
-#ifndef CHAR_BIT
-#define CHAR_BIT 8
-#endif
-
-/* Minimum and maximum values a `signed int' can hold. */
-#ifndef INT_MAX
-#define INT_MAX 2147483647
-#endif
-
-#ifndef INT_MIN
-#define INT_MIN (-INT_MAX - 1)
-#endif
-
-#ifndef UINT_MAX
-# define UINT_MAX 4294967295U
-#endif
-
-/*
-static void erts_ose_sys_send(union SIGNAL **signal,PROCESS dst,
- char* file,int line) {
- SIGSELECT **ziggy = (SIGSELECT**)signal;
- printf("%s:%d 0x%x Send signal 0x%x(0x%x) to 0x%x\r\n",
- file,line,current_process(),ziggy[0][0],*ziggy,dst);
- send(signal,dst);
-}
-#define send(signal,dst) erts_ose_sys_send(signal,dst,__FILE__,__LINE__)
-
-static void erts_ose_sys_send_w_sender(union SIGNAL **signal,
- PROCESS sender,PROCESS dst,
- char* file,int line) {
- SIGSELECT **ziggy = (SIGSELECT**)signal;
- printf("%s:%d 0x%x Send signal 0x%x(0x%x) to 0x%x as 0x%x\r\n",
- file,line,current_process(),ziggy[0][0],*ziggy,dst,sender);
- send_w_sender(signal,sender,dst);
-}
-#define send_w_sender(signal,sender,dst) \
- erts_ose_sys_send_w_sender(signal,sender,dst,__FILE__,__LINE__)
-
-
-static union SIGNAL *erts_ose_sys_receive(SIGSELECT *sigsel,
- char *file,
- int line) {
- SIGSELECT *sig;
- int i;
-
- printf("%s:%d 0x%x receive({%d,",file,line,current_process(),sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("})\n");
- sig = (SIGSELECT*)receive(sigsel);
- printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(),
- *sig,sender((union SIGNAL**)(&sig)));
- return (union SIGNAL*)sig;
-}
-#define receive(SIGSEL) erts_ose_sys_receive(SIGSEL,__FILE__,__LINE__)
-
-static union SIGNAL *erts_ose_sys_receive_w_tmo(OSTIME tmo,SIGSELECT *sigsel,
- char *file,int line) {
- SIGSELECT *sig;
- int i;
- if (tmo == 0) {
- sig = (SIGSELECT*)receive_w_tmo(tmo,sigsel);
- if (sig != NULL) {
- printf("%s:%d 0x%x receive_w_tmo(0,{%d,",file,line,current_process(),
- sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("})\n");
- printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(),
- *sig,sender((union SIGNAL**)(&sig)));
- }
- } else {
- printf("%s:%d 0x%x receive_w_tmo(%u,{%d,",file,line,current_process(),tmo,
- sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("})\n");
- sig = (SIGSELECT*)receive_w_tmo(tmo,sigsel);
- printf("%s:%d 0x%x got ",file,line,current_process());
- if (sig == NULL)
- printf("TIMEOUT\n");
- else
- printf("0x%x from 0x%x\n",*sig,sender((union SIGNAL**)(&sig)));
- }
-
- return (union SIGNAL*)sig;
-}
-
-#define receive_w_tmo(tmo,sigsel) erts_ose_sys_receive_w_tmo(tmo,sigsel, \
- __FILE__,__LINE__)
-
-static union SIGNAL *erts_ose_sys_receive_fsem(OSTIME tmo,SIGSELECT *sigsel,
- OSFSEMVAL fsem,
- char *file,int line) {
- SIGSELECT *sig;
- int i;
- if (tmo == 0) {
- sig = (SIGSELECT*)receive_fsem(tmo,sigsel,fsem);
- if (sig != NULL && sig != OS_RCV_FSEM) {
- printf("%s:%d 0x%x receive_fsem(0,{%d,",file,line,current_process(),
- sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("},%d)\n",fsem);
- printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(),
- *sig,sender((union SIGNAL**)(&sig)));
- }
- } else {
- printf("%s:%d 0x%x receive_fsem(%u,{%d,",file,line,current_process(),tmo,
- sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("},%d)\n",fsem);
- sig = (SIGSELECT*)receive_fsem(tmo,sigsel,fsem);
- printf("%s:%d 0x%x got ",file,line,current_process());
- if (sig == NULL)
- printf("TIMEOUT\n");
- else if (sig == OS_RCV_FSEM)
- printf("FSEM\n");
- else
- printf("0x%x from 0x%x\n",*sig,sender((union SIGNAL**)(&sig)));
- }
-
- return (union SIGNAL*)sig;
-}
-
-#define receive_fsem(tmo,sigsel,fsem) \
- erts_ose_sys_receive_fsem(tmo,sigsel,fsem,__FILE__,__LINE__)
-*/
-#endif /* _ERL_OSE_SYS_H */
diff --git a/erts/emulator/sys/ose/erl_ose_sys_ddll.c b/erts/emulator/sys/ose/erl_ose_sys_ddll.c
deleted file mode 100644
index 5051f7fcc1..0000000000
--- a/erts/emulator/sys/ose/erl_ose_sys_ddll.c
+++ /dev/null
@@ -1,127 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Interface functions to the dynamic linker using dl* functions.
- * (No support in OSE, we use static linkage instead)
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
-
-
-void erl_sys_ddll_init(void) {
-}
-
-/*
- * Open a shared object
- */
-int erts_sys_ddll_open(const char *full_name, void **handle, ErtsSysDdllError* err)
-{
- return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY;
-}
-
-int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err)
-{
- return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY;
-}
-
-/*
- * Find a symbol in the shared object
- */
-int erts_sys_ddll_sym2(void *handle, const char *func_name, void **function,
- ErtsSysDdllError* err)
-{
- return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY;
-}
-
-/* XXX:PaN These two will be changed with new driver interface! */
-
-/*
- * Load the driver init function, might appear under different names depending on object arch...
- */
-
-int erts_sys_ddll_load_driver_init(void *handle, void **function)
-{
- void *fn;
- int res;
- if ((res = erts_sys_ddll_sym2(handle, "driver_init", &fn, NULL)) != ERL_DE_NO_ERROR) {
- res = erts_sys_ddll_sym2(handle, "_driver_init", &fn, NULL);
- }
- if (res == ERL_DE_NO_ERROR) {
- *function = fn;
- }
- return res;
-}
-
-int erts_sys_ddll_load_nif_init(void *handle, void **function, ErtsSysDdllError* err)
-{
- void *fn;
- int res;
- if ((res = erts_sys_ddll_sym2(handle, "nif_init", &fn, err)) != ERL_DE_NO_ERROR) {
- res = erts_sys_ddll_sym2(handle, "_nif_init", &fn, err);
- }
- if (res == ERL_DE_NO_ERROR) {
- *function = fn;
- }
- return res;
-}
-
-/*
- * Call the driver_init function, whatever it's really called, simple on unix...
-*/
-void *erts_sys_ddll_call_init(void *function) {
- void *(*initfn)(void) = function;
- return (*initfn)();
-}
-void *erts_sys_ddll_call_nif_init(void *function) {
- return erts_sys_ddll_call_init(function);
-}
-
-
-
-/*
- * Close a chared object
- */
-int erts_sys_ddll_close2(void *handle, ErtsSysDdllError* err)
-{
- return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY;
-}
-
-
-/*
- * Return string that describes the (current) error
- */
-char *erts_sys_ddll_error(int code)
-{
- return "Unspecified error";
-}
-
-void erts_sys_ddll_free_error(ErtsSysDdllError* err)
-{
- if (err->str != NULL) {
- erts_free(ERTS_ALC_T_DDLL_TMP_BUF, err->str);
- }
-}
diff --git a/erts/emulator/sys/ose/erl_poll.c b/erts/emulator/sys/ose/erl_poll.c
deleted file mode 100644
index 5cee582a00..0000000000
--- a/erts/emulator/sys/ose/erl_poll.c
+++ /dev/null
@@ -1,818 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2006-2012. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Description: Poll interface suitable for ERTS on OSE with or without
- * SMP support.
- *
- * The interface is currently implemented using:
- * - receive + receive_fsem
- *
- * Author: Lukas Larsson
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "erl_thr_progress.h"
-#include "erl_driver.h"
-#include "erl_alloc.h"
-#include "erl_poll.h"
-
-#define NOFILE 4096
-
-/*
- * Some debug macros
- */
-
-/* #define HARDDEBUG
-#define HARDTRACE*/
-#ifdef HARDDEBUG
-#ifdef HARDTRACE
-#define HARDTRACEF(X, ...) { fprintf(stderr, X, __VA_ARGS__); fprintf(stderr,"\r\n"); }
-#else
-#define HARDTRACEF(...)
-#endif
-
-#else
-#define HARDTRACEF(X,...)
-#define HARDDEBUGF(...)
-#endif
-
-#if 0
-#define ERTS_POLL_DEBUG_PRINT
-#endif
-
-#if defined(DEBUG) && 0
-#define HARD_DEBUG
-#endif
-
-# define SEL_ALLOC erts_alloc
-# define SEL_REALLOC realloc_wrap
-# define SEL_FREE erts_free
-
-#ifdef ERTS_SMP
-
-#define ERTS_POLLSET_LOCK(PS) \
- erts_smp_mtx_lock(&(PS)->mtx)
-#define ERTS_POLLSET_UNLOCK(PS) \
- erts_smp_mtx_unlock(&(PS)->mtx)
-
-#else
-
-#define ERTS_POLLSET_LOCK(PS)
-#define ERTS_POLLSET_UNLOCK(PS)
-
-#endif
-
-/*
- * --- Data types ------------------------------------------------------------
- */
-
-union SIGNAL {
- SIGSELECT sig_no;
-};
-
-typedef struct erts_sigsel_item_ ErtsSigSelItem;
-
-struct erts_sigsel_item_ {
- ErtsSigSelItem *next;
- ErtsSysFdType fd;
- ErtsPollEvents events;
-};
-
-typedef struct erts_sigsel_info_ ErtsSigSelInfo;
-
-struct erts_sigsel_info_ {
- ErtsSigSelInfo *next;
- SIGSELECT signo;
- ErlDrvOseEventId (*decode)(union SIGNAL* sig);
- ErtsSigSelItem *fds;
-};
-
-struct ErtsPollSet_ {
- SIGSELECT *sigs;
- ErtsSigSelInfo *info;
- Uint sig_count;
- Uint item_count;
- PROCESS interrupt;
- erts_atomic32_t wakeup_state;
- erts_atomic64_t timeout_time;
-#ifdef ERTS_SMP
- erts_smp_mtx_t mtx;
-#endif
-};
-
-static int max_fds = -1;
-
-static ERTS_INLINE void
-init_timeout_time(ErtsPollSet ps)
-{
- erts_atomic64_init_nob(&ps->timeout_time,
- (erts_aint64_t) ERTS_MONOTONIC_TIME_MAX);
-}
-
-static ERTS_INLINE void
-set_timeout_time(ErtsPollSet ps, ErtsMonotonicTime time)
-{
- erts_atomic64_set_relb(&ps->timeout_time,
- (erts_aint64_t) time);
-}
-
-static ERTS_INLINE ErtsMonotonicTime
-get_timeout_time(ErtsPollSet ps)
-{
- return (ErtsMonotonicTime) erts_atomic64_read_acqb(&ps->timeout_time);
-}
-
-#define ERTS_POLL_NOT_WOKEN ((erts_aint32_t) (1 << 0))
-#define ERTS_POLL_WOKEN_INTR ((erts_aint32_t) (1 << 1))
-#define ERTS_POLL_WOKEN_TIMEDOUT ((erts_aint32_t) (1 << 2))
-#define ERTS_POLL_WOKEN_IO_READY ((erts_aint32_t) (1 << 3))
-#define ERTS_POLL_SLEEPING ((erts_aint32_t) (1 << 4))
-
-/* signal list prototypes */
-static ErtsSigSelInfo *get_sigsel_info(ErtsPollSet ps, SIGSELECT signo);
-static ErtsSigSelItem *get_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd);
-static ErtsSigSelInfo *add_sigsel_info(ErtsPollSet ps, ErtsSysFdType fd,
- ErlDrvOseEventId (*decode)(union SIGNAL* sig));
-static ErtsSigSelItem *add_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd,
- ErlDrvOseEventId (*decode)(union SIGNAL* sig));
-static int del_sigsel_info(ErtsPollSet ps, ErtsSigSelInfo *info);
-static int del_sigsel_item(ErtsPollSet ps, ErtsSigSelItem *item);
-static int update_sigsel(ErtsPollSet ps);
-
-static ErtsSigSelInfo *
-get_sigsel_info(ErtsPollSet ps, SIGSELECT signo) {
- ErtsSigSelInfo *curr = ps->info;
- while (curr != NULL) {
- if (curr->signo == signo)
- return curr;
- curr = curr->next;
- }
- return NULL;
-}
-
-static ErtsSigSelItem *
-get_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd) {
- ErtsSigSelInfo *info = get_sigsel_info(ps,fd->signo);
- ErtsSigSelItem *curr;
-
- if (info == NULL)
- return NULL;
-
- curr = info->fds;
-
- while (curr != NULL) {
- if (curr->fd->id == fd->id) {
- ASSERT(curr->fd->signo == fd->signo);
- return curr;
- }
- curr = curr->next;
- }
- return NULL;
-}
-
-static ErtsSigSelInfo *
-add_sigsel_info(ErtsPollSet ps, ErtsSysFdType fd,
- ErlDrvOseEventId (*decode)(union SIGNAL* sig)) {
- ErtsSigSelInfo *info = SEL_ALLOC(ERTS_ALC_T_POLLSET,
- sizeof(ErtsSigSelInfo));
- info->next = ps->info;
- info->fds = NULL;
- info->signo = fd->signo;
- info->decode = decode;
- ps->info = info;
- ps->sig_count++;
- return info;
-}
-
-static ErtsSigSelItem *
-add_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd,
- ErlDrvOseEventId (*decode)(union SIGNAL* sig)) {
- ErtsSigSelInfo *info = get_sigsel_info(ps,fd->signo);
- ErtsSigSelItem *item = SEL_ALLOC(ERTS_ALC_T_POLLSET,
- sizeof(ErtsSigSelItem));
- if (info == NULL)
- info = add_sigsel_info(ps, fd, decode);
- if (info->decode != decode) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp, "erts_poll_control() inconsistency: multiple resolve_signal functions for same signal (%d)\n",
- fd->signo);
- erts_send_error_to_logger_nogl(dsbufp);
- }
- ASSERT(info->decode == decode);
- item->next = info->fds;
- item->fd = fd;
- item->events = 0;
- info->fds = item;
- ps->item_count++;
- return item;
-}
-
-static int del_sigsel_info(ErtsPollSet ps, ErtsSigSelInfo *info) {
- ErtsSigSelInfo *curr, *prev;
-
- if (ps->info == info) {
- ps->info = ps->info->next;
- } else {
- curr = ps->info->next;
- prev = ps->info;
-
- while (curr != info) {
- if (curr == NULL)
- return 1;
- prev = curr;
- curr = curr->next;
- }
- prev->next = curr->next;
- }
-
- ps->sig_count--;
- SEL_FREE(ERTS_ALC_T_POLLSET, info);
- return 0;
-}
-
-static int del_sigsel_item(ErtsPollSet ps, ErtsSigSelItem *item) {
- ErtsSigSelInfo *info = get_sigsel_info(ps,item->fd->signo);
- ErtsSigSelItem *curr, *prev;
-
- ps->item_count--;
- ASSERT(ps->item_count >= 0);
-
- if (info->fds == item) {
- info->fds = info->fds->next;
- SEL_FREE(ERTS_ALC_T_POLLSET,item);
- if (info->fds == NULL)
- return del_sigsel_info(ps,info);
- return 0;
- }
-
- curr = info->fds->next;
- prev = info->fds;
-
- while (curr != item) {
- if (curr == NULL) {
- /* We did not find an item to delete so we have to
- * increment item count again.
- */
- ps->item_count++;
- return 1;
- }
- prev = curr;
- curr = curr->next;
- }
- prev->next = curr->next;
- SEL_FREE(ERTS_ALC_T_POLLSET,item);
- return 0;
-}
-
-#ifdef ERTS_SMP
-
-static void update_redir_tables(ErtsPollSet ps) {
- struct OS_redir_entry *redir_table;
- PROCESS sched_1 = ERTS_SCHEDULER_IX(0)->tid.id;
- int i;
- redir_table = SEL_ALLOC(ERTS_ALC_T_POLLSET,
- sizeof(struct OS_redir_entry)*(ps->sig_count+1));
-
- redir_table[0].sig = ps->sig_count+1;
- redir_table[0].pid = 0;
-
- for (i = 1; i < ps->sig_count+1; i++) {
- redir_table[i].sig = ps->sigs[i];
- redir_table[i].pid = sched_1;
- }
-
- for (i = 1; i < erts_no_schedulers; i++) {
- ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(i);
- set_redirection(esdp->tid.id,redir_table);
- }
-
- SEL_FREE(ERTS_ALC_T_POLLSET,redir_table);
-}
-
-#endif
-
-static int update_sigsel(ErtsPollSet ps) {
- ErtsSigSelInfo *info = ps->info;
-
- int i;
-
- if (ps->sigs != NULL)
- SEL_FREE(ERTS_ALC_T_POLLSET,ps->sigs);
-
- if (ps->sig_count == 0) {
- /* If there are no signals we place a non-valid signal to make sure that
- * we do not trigger on a any unrelated signals which are sent to the
- * process.
- */
- ps->sigs = SEL_ALLOC(ERTS_ALC_T_POLLSET,sizeof(SIGSELECT)*(2));
- ps->sigs[0] = 1;
- ps->sigs[1] = ERTS_SIGNAL_INVALID;
- return 0;
- }
-
- ps->sigs = SEL_ALLOC(ERTS_ALC_T_POLLSET,sizeof(SIGSELECT)*(ps->sig_count+1));
- ps->sigs[0] = ps->sig_count;
-
- for (i = 1; info != NULL; i++, info = info->next)
- ps->sigs[i] = info->signo;
-
-#ifdef ERTS_SMP
- update_redir_tables(ps);
-#endif
-
- return 0;
-}
-
-static ERTS_INLINE void
-wake_poller(ErtsPollSet ps)
-{
- erts_aint32_t wakeup_state;
-
- ERTS_THR_MEMORY_BARRIER;
- wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
- while (wakeup_state != ERTS_POLL_WOKEN_IO_READY
- && wakeup_state != ERTS_POLL_WOKEN_INTR) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_INTR,
- wakeup_state);
- if (act == wakeup_state) {
- wakeup_state = act;
- break;
- }
- wakeup_state = act;
- }
- if (wakeup_state == ERTS_POLL_SLEEPING) {
- /*
- * Since we don't know the internals of signal_fsem() we issue
- * a memory barrier as a safety precaution ensuring that
- * the store we just made to wakeup_state wont be reordered
- * with loads in signal_fsem().
- */
- ERTS_THR_MEMORY_BARRIER;
- signal_fsem(ps->interrupt);
- }
-}
-
-static ERTS_INLINE void
-reset_interrupt(ErtsPollSet ps)
-{
- /* We need to keep io-ready if set */
- erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
- while (wakeup_state != ERTS_POLL_NOT_WOKEN &&
- wakeup_state != ERTS_POLL_SLEEPING) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_NOT_WOKEN,
- wakeup_state);
- if (wakeup_state == act)
- break;
- wakeup_state = act;
- }
- ERTS_THR_MEMORY_BARRIER;
-}
-
-static ERTS_INLINE void
-set_interrupt(ErtsPollSet ps)
-{
- wake_poller(ps);
-}
-
-void erts_poll_interrupt(ErtsPollSet ps,int set) {
- HARDTRACEF("erts_poll_interrupt called!\n");
-
- if (!set)
- reset_interrupt(ps);
- else
- set_interrupt(ps);
-
-}
-
-void erts_poll_interrupt_timed(ErtsPollSet ps,
- int set,
- ErtsTimeoutTime timeout_time) {
- HARDTRACEF("erts_poll_interrupt_timed called!\n");
-
- if (!set)
- reset_interrupt(ps);
- else if (get_timeout_time(ps) > timeout_time)
- set_interrupt(ps);
-}
-
-ErtsPollEvents erts_poll_control(ErtsPollSet ps, ErtsSysFdType fd,
- ErtsPollEvents pe, int on, int* do_wake) {
- ErtsSigSelItem *curr;
- ErtsPollEvents new_events;
- int old_sig_count;
-
- HARDTRACEF(
- "%ux: In erts_poll_control, fd = %d, pe = %d, on = %d, *do_wake = %d, curr = 0x%xu",
- ps, fd, pe, on, do_wake, curr);
-
- ERTS_POLLSET_LOCK(ps);
-
- if (on && (pe & ERTS_POLL_EV_IN) && (pe & ERTS_POLL_EV_OUT)) {
- /* Check to make sure both in and out are not used at the same time */
- new_events = ERTS_POLL_EV_NVAL;
- goto done;
- }
-
- curr = get_sigsel_item(ps, fd);
- old_sig_count = ps->sig_count;
-
- if (curr == NULL && on) {
- curr = add_sigsel_item(ps, fd, fd->resolve_signal);
- } else if (curr == NULL && !on) {
- new_events = ERTS_POLL_EV_NVAL;
- goto done;
- }
-
- new_events = curr->events;
-
- if (pe == 0) {
- *do_wake = 0;
- goto done;
- }
-
- if (on) {
- new_events |= pe;
- curr->events = new_events;
- } else {
- new_events &= ~pe;
- curr->events = new_events;
- if (new_events == 0 && del_sigsel_item(ps, curr)) {
- new_events = ERTS_POLL_EV_NVAL;
- goto done;
- }
- }
-
- if (ps->sig_count != old_sig_count) {
- if (update_sigsel(ps))
- new_events = ERTS_POLL_EV_NVAL;
- }
-done:
- ERTS_POLLSET_UNLOCK(ps);
- HARDTRACEF("%ux: Out erts_poll_control", ps);
- return new_events;
-}
-
-int erts_poll_wait(ErtsPollSet ps,
- ErtsPollResFd pr[],
- int *len,
- ErtsMonotonicTime timeout_time)
-{
- int res = ETIMEDOUT, no_fds, currid = 0;
- OSTIME timeout;
- union SIGNAL *sig;
- ErtsMonotonicTime current_time, diff_time, timeout;
- // HARDTRACEF("%ux: In erts_poll_wait",ps);
- if (ps->interrupt == (PROCESS)0)
- ps->interrupt = current_process();
-
- ASSERT(current_process() == ps->interrupt);
- ASSERT(get_fsem(current_process()) == 0);
- ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) &
- (ERTS_POLL_NOT_WOKEN | ERTS_POLL_WOKEN_INTR));
- /* Max no of spots avable in pr */
- no_fds = *len;
-
- *len = 0;
-
- /* erts_printf("Entering erts_poll_wait(), timeout_time=%bps\n",
- timeout_time); */
-
- if (timeout_time == ERTS_POLL_NO_TIMEOUT) {
- no_timeout:
- timeout = (OSTIME) 0;
- save_timeout_time = ERTS_MONOTONIC_TIME_MIN;
- }
- else {
- ErtsMonotonicTime current_time, diff_time;
- current_time = erts_get_monotonic_time(NULL);
- diff_time = timeout_time - current_time;
- if (diff_time <= 0)
- goto no_timeout;
- diff_time = (ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1);
- if (diff_time > INT_MAX)
- diff_time = INT_MAX;
- timeout = (OSTIME) diff_time;
- save_timeout_time = current_time;
- save_timeout_time += ERTS_MSEC_TO_MONOTONIC(diff_time);
- }
-
- set_timeout_time(ps, save_timeout_time);
-
- while (currid < no_fds) {
- if (timeout > 0) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_SLEEPING,
- ERTS_POLL_NOT_WOKEN);
- if (act == ERTS_POLL_NOT_WOKEN) {
-#ifdef ERTS_SMP
- erts_thr_progress_prepare_wait(NULL);
-#endif
- sig = receive_fsem(timeout, ps->sigs, 1);
-#ifdef ERTS_SMP
- erts_thr_progress_finalize_wait(NULL);
-#endif
- } else {
- ASSERT(act == ERTS_POLL_WOKEN_INTR);
- sig = OS_RCV_FSEM;
- }
- } else
- sig = receive_w_tmo(0, ps->sigs);
-
- if (sig == NULL) {
- if (timeout > 0) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_TIMEDOUT,
- ERTS_POLL_SLEEPING);
- if (act == ERTS_POLL_WOKEN_INTR)
- /* Restore fsem as it was signaled but we got a timeout */
- wait_fsem(1);
- } else
- erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_TIMEDOUT,
- ERTS_POLL_NOT_WOKEN);
- break;
- } else if (sig == OS_RCV_FSEM) {
- ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) == ERTS_POLL_WOKEN_INTR);
- break;
- }
- {
- ErtsSigSelInfo *info = get_sigsel_info(ps, sig->sig_no);
- struct erts_sys_fd_type fd = { sig->sig_no, info->decode(sig) };
- ErtsSigSelItem *item = get_sigsel_item(ps, &fd);
-
- ASSERT(sig);
- if (currid == 0 && timeout > 0) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_IO_READY,
- ERTS_POLL_SLEEPING);
- if (act == ERTS_POLL_WOKEN_INTR) {
- /* Restore fsem as it was signaled but we got a msg */
- wait_fsem(1);
- act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_IO_READY,
- ERTS_POLL_WOKEN_INTR);
- }
- } else if (currid == 0) {
- erts_atomic32_set_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_IO_READY);
- }
-
- if (item == NULL) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(
- dsbufp,
- "erts_poll_wait() failed: found unkown signal id %d (signo %u) "
- "(curr_proc 0x%x)\n",
- fd.id, fd.signo, current_process());
- erts_send_error_to_logger_nogl(dsbufp);
- timeout = 0;
- /* Under normal circumstances the signal is deallocated by the
- * driver that issued the select operation. But in this case
- * there's no driver waiting for such signal so we have to
- * deallocate it here */
- if (sig)
- free_buf(&sig);
- } else {
- int i;
- struct erts_sys_fd_type *fd = NULL;
- ErtsPollOseMsgList *tl,*new;
-
- /* Check if this fd has already been triggered by a previous signal */
- for (i = 0; i < currid;i++) {
- if (pr[i].fd == item->fd) {
- fd = pr[i].fd;
- pr[i].events |= item->events;
- break;
- }
- }
-
- /* First time this fd is triggered */
- if (fd == NULL) {
- pr[currid].fd = item->fd;
- pr[currid].events = item->events;
- fd = item->fd;
- timeout = 0;
- currid++;
- }
-
- /* Insert new signal in approriate list */
- new = erts_alloc(ERTS_ALC_T_FD_SIG_LIST,sizeof(ErtsPollOseMsgList));
- new->next = NULL;
- new->data = sig;
-
- ethr_mutex_lock(&fd->mtx);
- tl = fd->msgs;
-
- if (tl == NULL) {
- fd->msgs = new;
- } else {
- while (tl->next != NULL)
- tl = tl->next;
- tl->next = new;
- }
- ethr_mutex_unlock(&fd->mtx);
- }
-
- }
- }
-
- {
- erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
-
- switch (wakeup_state) {
- case ERTS_POLL_WOKEN_IO_READY:
- res = 0;
- break;
- case ERTS_POLL_WOKEN_INTR:
- res = EINTR;
- break;
- case ERTS_POLL_WOKEN_TIMEDOUT:
- res = ETIMEDOUT;
- break;
- case ERTS_POLL_NOT_WOKEN:
- /* This happens when we get an invalid signal only */
- res = EINVAL;
- break;
- default:
- res = 0;
- erl_exit(ERTS_ABORT_EXIT,
- "%s:%d: Internal error: Invalid wakeup_state=%d\n",
- __FILE__, __LINE__, (int) wakeup_state);
- }
- }
-
- erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
- set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX);
-
- *len = currid;
-
- // HARDTRACEF("%ux: Out erts_poll_wait",ps);
- return res;
-}
-
-int erts_poll_max_fds(void)
-{
-
- HARDTRACEF("In/Out erts_poll_max_fds -> %d",max_fds);
- return max_fds;
-}
-
-void erts_poll_info(ErtsPollSet ps,
- ErtsPollInfo *pip)
-{
- Uint size = 0;
- Uint num_events = 0;
-
- size += sizeof(struct ErtsPollSet_);
- size += sizeof(ErtsSigSelInfo)*ps->sig_count;
- size += sizeof(ErtsSigSelItem)*ps->item_count;
- size += sizeof(SIGSELECT)*(ps->sig_count+1);
-
- pip->primary = "receive_fsem";
-
- pip->fallback = NULL;
-
- pip->kernel_poll = NULL;
-
- pip->memory_size = size;
-
- pip->poll_set_size = num_events;
-
- pip->fallback_poll_set_size = 0;
-
- pip->lazy_updates = 0;
-
- pip->pending_updates = 0;
-
- pip->batch_updates = 0;
-
- pip->concurrent_updates = 0;
-
-
- pip->max_fds = erts_poll_max_fds();
- HARDTRACEF("%ux: Out erts_poll_info",ps);
-
-}
-
-ErtsPollSet erts_poll_create_pollset(void)
-{
- ErtsPollSet ps = SEL_ALLOC(ERTS_ALC_T_POLLSET,
- sizeof(struct ErtsPollSet_));
-
- ps->sigs = NULL;
- ps->sig_count = 0;
- ps->item_count = 0;
- ps->info = NULL;
- ps->interrupt = (PROCESS)0;
- erts_atomic32_init_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
- init_timeout_time(ps);
-#ifdef ERTS_SMP
- erts_smp_mtx_init(&ps->mtx, "pollset");
-#endif
- update_sigsel(ps);
- HARDTRACEF("%ux: Out erts_poll_create_pollset",ps);
- return ps;
-}
-
-void erts_poll_destroy_pollset(ErtsPollSet ps)
-{
- ErtsSigSelInfo *info;
- for (info = ps->info; ps->info != NULL; info = ps->info, ps->info = ps->info->next) {
- ErtsSigSelItem *item;
- for (item = info->fds; info->fds != NULL; item = info->fds, info->fds = info->fds->next)
- SEL_FREE(ERTS_ALC_T_POLLSET, item);
- SEL_FREE(ERTS_ALC_T_POLLSET, info);
- }
-
- SEL_FREE(ERTS_ALC_T_POLLSET,ps->sigs);
-
-#ifdef ERTS_SMP
- erts_smp_mtx_destroy(&ps->mtx);
-#endif
-
- SEL_FREE(ERTS_ALC_T_POLLSET,ps);
-}
-
-void erts_poll_init(void)
-{
- HARDTRACEF("In %s", __FUNCTION__);
- max_fds = 256;
-
- HARDTRACEF("Out %s", __FUNCTION__);
-}
-
-
-/* OSE driver functions */
-
-union SIGNAL *erl_drv_ose_get_signal(ErlDrvEvent drv_ev) {
- struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev;
- ethr_mutex_lock(&ev->mtx);
- if (ev->msgs == NULL) {
- ethr_mutex_unlock(&ev->mtx);
- return NULL;
- } else {
- ErtsPollOseMsgList *msg = ev->msgs;
- union SIGNAL *sig = (union SIGNAL*)msg->data;
- ASSERT(msg->data);
- ev->msgs = msg->next;
- ethr_mutex_unlock(&ev->mtx);
- erts_free(ERTS_ALC_T_FD_SIG_LIST,msg);
- restore(sig);
- return sig;
- }
-}
-
-ErlDrvEvent
-erl_drv_ose_event_alloc(SIGSELECT signo, ErlDrvOseEventId id,
- ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig), void *extra) {
- struct erts_sys_fd_type *ev = erts_alloc(ERTS_ALC_T_DRV_EV,
- sizeof(struct erts_sys_fd_type));
- ev->signo = signo;
- ev->extra = extra;
- ev->id = id;
- ev->msgs = NULL;
- ev->resolve_signal = resolve_signal;
- ethr_mutex_init(&ev->mtx);
- return (ErlDrvEvent)ev;
-}
-
-void erl_drv_ose_event_free(ErlDrvEvent drv_ev) {
- struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev;
- ASSERT(ev->msgs == NULL);
- ethr_mutex_destroy(&ev->mtx);
- erts_free(ERTS_ALC_T_DRV_EV,ev);
-}
-
-void erl_drv_ose_event_fetch(ErlDrvEvent drv_ev, SIGSELECT *signo,
- ErlDrvOseEventId *id, void **extra) {
- struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev;
- if (signo)
- *signo = ev->signo;
- if (extra)
- *extra = ev->extra;
- if (id)
- *id = ev->id;
-}
diff --git a/erts/emulator/sys/ose/erts.sig b/erts/emulator/sys/ose/erts.sig
deleted file mode 100644
index 78b883ee6c..0000000000
--- a/erts/emulator/sys/ose/erts.sig
+++ /dev/null
@@ -1,17 +0,0 @@
-#ifndef ERTS_OSE_SIGNALS
-#define ERTS_OSE_SIGNALS
-
-#ifndef ERTS_OSE_SIGNAL_BASE
-#define ERTS_OSE_SIGNAL_BASE 0x01900280
-#endif
-
-#define ERTS_SIGNAL_INVALID ERTS_OSE_SIGNAL_BASE
-#define ERTS_SIGNAL_FD_DRV_CONFIG ERTS_OSE_SIGNAL_BASE+1
-#define ERTS_SIGNAL_FD_DRV_ASYNC ERTS_OSE_SIGNAL_BASE+2
-#define ERTS_SIGNAL_OSE_DRV_ATTACH ERTS_OSE_SIGNAL_BASE+3
-#define ERTS_SIGNAL_OSE_DRV_HUNT ERTS_OSE_SIGNAL_BASE+4
-
-#define ERTS_SIGNAL_RUN_ERL_SETUP ERTS_OSE_SIGNAL_BASE+100
-#define ERTS_SIGNAL_RUN_ERL_DAEMON ERTS_OSE_SIGNAL_BASE+101
-
-#endif
diff --git a/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf b/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf
deleted file mode 100644
index a19d23facf..0000000000
--- a/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf
+++ /dev/null
@@ -1,182 +0,0 @@
-/*******************************************************************************
- * Copyright (C) 2013-2014 by Enea Software AB,
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- *
- * 3. Neither the name of the copyright holder nor the names of its contributors
- * may be used to endorse or promote products derived from this software
- * without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
- * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
- * POSSIBILITY OF SUCH DAMAGE.
- ******************************************************************************/
-
-OUTPUT_FORMAT("elf32-powerpc", "elf32-powerpc", "elf32-powerpc")
-OUTPUT_ARCH("powerpc")
-ENTRY("crt0_lm")
-MEMORY
-{
- rom : ORIGIN = 0x01000000, LENGTH = 0x01000000
- ram : ORIGIN = 0x02000000, LENGTH = 0x01000000
-}
-PHDRS
-{
- ph_conf PT_LOAD ;
- ph_rom PT_LOAD ;
- ph_ram PT_LOAD ;
-}
-SECTIONS
-{
- .text :
- {
- *(.text_first)
- *(.text)
- *(.text.*)
- *(.stub)
- *(oscode)
- *(.init*)
- *(.fini*)
- *(.gnu.warning)
- *(.gnu.linkonce.t.*)
- *(.glue_7t)
- *(.glue_7)
- } > rom :ph_rom = 0
- .ose_sfk_biosentry :
- {
- *(.ose_sfk_biosentry)
- } > rom :ph_rom
- .ctors :
- {
- __CTOR_LIST__ = .;
- *(.ctors)
- *(SORT(.ctors.*))
- __CTOR_END__ = .;
- } > rom :ph_rom
- .dtors :
- {
- __DTOR_LIST__ = .;
- *(.dtors)
- *(SORT(.dtors.*))
- __DTOR_END__ = .;
- } > rom :ph_rom
- OSESYMS :
- {
- *(.osesyms)
- } > rom :ph_rom
- .rodata :
- {
- *(.rodata)
- *(.rodata.*)
- *(.gnu.linkonce.r.*)
- } > rom :ph_rom
- .eh_frame_hdr :
- {
- *(.eh_frame_hdr)
- } > rom :ph_rom
- .eh_frame :
- {
- __EH_FRAME_BEGIN__ = .;
- *(.eh_frame)
- LONG(0)
- __EH_FRAME_END__ = .;
- } > rom :ph_rom
- .gcc_except_table :
- {
- *(.gcc_except_table .gcc_except_table.*)
- } > rom :ph_rom
- .sdata2 :
- {
- PROVIDE (_SDA2_BASE_ = .);
- *(.sdata2)
- *(.sdata2.*)
- *(.gnu.linkonce.s2.*)
- } > rom :ph_rom
- .sbss2 :
- {
- *(.sbss2)
- *(.sbss2.*)
- *(.gnu.linkonce.sb2.*)
- } > rom :ph_rom
- LMCONF :
- {
- obj/?*?/ose_confd.o(.rodata)
- *(LMCONF)
- } > rom :ph_conf
- .data :
- {
- LONG(0xDEADBABE)
- *(.data)
- *(.data.*)
- *(.gnu.linkonce.d.*)
- SORT(CONSTRUCTORS)
- . = ALIGN(0x10);
- } > ram :ph_ram = 0
- .sdata2 :
- {
- _SDA2_BASE_ = .;
- *(.sdata2 .sdata2.* .gnu.linkonce.s2.*)
- }> ram :ph_ram
- .sdata :
- {
- PROVIDE (_SDA_BASE_ = .);
- *(.sdata)
- *(.sdata.*)
- *(.gnu.linkonce.s.*)
- } > ram :ph_ram
- .sbss :
- {
- *(.sbss)
- *(.sbss.*)
- *(.scommon)
- *(.gnu.linkonce.sb.*)
- } > ram :ph_ram
- .bss (NOLOAD) :
- {
- *(.bss)
- *(.bss.*)
- *(COMMON)
- *(.gnu.linkonce.b.*)
- *(.osvars)
- } > ram :ph_ram
- .ignore (NOLOAD) :
- {
- *(.rel.dyn)
- } > ram :ph_ram
- .debug 0 : { *(.debug) }
- .line 0 : { *(.line) }
- .debug_srcinfo 0 : { *(.debug_srcinfo) }
- .debug_sfnames 0 : { *(.debug_sfnames) }
- .debug_aranges 0 : { *(.debug_aranges) }
- .debug_pubnames 0 : { *(.debug_pubnames) }
- .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) }
- .debug_abbrev 0 : { *(.debug_abbrev) }
- .debug_line 0 : { *(.debug_line) }
- .debug_frame 0 : { *(.debug_frame) }
- .debug_str 0 : { *(.debug_str) }
- .debug_loc 0 : { *(.debug_loc) }
- .debug_macinfo 0 : { *(.debug_macinfo) }
- .debug_weaknames 0 : { *(.debug_weaknames) }
- .debug_funcnames 0 : { *(.debug_funcnames) }
- .debug_typenames 0 : { *(.debug_typenames) }
- .debug_varnames 0 : { *(.debug_varnames) }
-}
-__OSESYMS_START = ADDR(OSESYMS);
-__OSESYMS_END = ADDR(OSESYMS) + SIZEOF(OSESYMS);
diff --git a/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf b/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf
deleted file mode 100644
index 3440c2961b..0000000000
--- a/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf
+++ /dev/null
@@ -1,242 +0,0 @@
-/*******************************************************************************
- * Copyright (C) 2013-2014 by Enea Software AB,
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- *
- * 3. Neither the name of the copyright holder nor the names of its contributors
- * may be used to endorse or promote products derived from this software
- * without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
- * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
- * POSSIBILITY OF SUCH DAMAGE.
- ******************************************************************************/
-
-OUTPUT_FORMAT("elf32-powerpc", "elf32-powerpc", "elf32-powerpc")
-OUTPUT_ARCH("powerpc")
-
-ENTRY("crt0_lm")
-
-/* Note:
- * You may have to increase the length of the "rom" memory region and the
- * origin and length of the "ram" memory region below depending on the size
- * of the code and data in your load module.
- */
-
-MEMORY
-{
- conf : ORIGIN = 0x00100000, LENGTH = 0x00030000
- rom : ORIGIN = 0x01000000, LENGTH = 0x01000000
- ram : ORIGIN = 0x03000000, LENGTH = 0x01000000
-}
-
-PHDRS
-{
- ph_conf PT_LOAD ;
- ph_rom PT_LOAD ;
- ph_ram PT_LOAD ;
-}
-
-SECTIONS
-{
-/*---------------------------------------------------------------------------
- * Load module configuration area
- *-------------------------------------------------------------------------*/
-
- /* Load module configuration section. */
- LMCONF :
- {
- obj/?*?/ose_confd.o(.rodata)
- *(LMCONF)
- } > conf :ph_conf
-
-/*---------------------------------------------------------------------------
- * Read-only area
- *-------------------------------------------------------------------------*/
-
- /* Code section. */
- .text :
- {
- *(.text)
- *(.text.*)
- *(.stub)
- *(oscode)
- *(.init*)
- *(.fini*)
- *(.gnu.warning)
- *(.gnu.linkonce.t.*)
- } > rom :ph_rom = 0
-
- /* OSE symbols section. */
- OSESYMS :
- {
- *(.osesyms)
- } > rom :ph_rom
-
- /* Read-only data section. */
- .rodata :
- {
- *(.rodata)
- *(.rodata.*)
- *(.gnu.linkonce.r.*)
- } > rom :ph_rom
-
- /* C++ exception handling section. */
- .eh_frame :
- {
- __EH_FRAME_BEGIN__ = .;
- *(.eh_frame)
- LONG(0)
- __EH_FRAME_END__ = .;
- } > rom :ph_rom
-
- /* C++ exception handling section. */
- .gcc_except_table :
- {
- *(.gcc_except_table .gcc_except_table.*)
- } > rom :ph_rom
-
- /* PowerPC EABI initialized read-only data section. */
- .sdata2 :
- {
- PROVIDE (_SDA2_BASE_ = .);
- *(.sdata2)
- *(.sdata2.*)
- *(.gnu.linkonce.s2.*)
- } > rom :ph_rom
-
- /* PowerPC EABI uninitialized read-only data section. */
- .sbss2 :
- {
- *(.sbss2)
- *(.sbss2.*)
- *(.gnu.linkonce.sb2.*)
- } > rom :ph_rom
-
-/*---------------------------------------------------------------------------
- * Read-write area
- *-------------------------------------------------------------------------*/
-
- /*-------------------------------------------------------------------
- * Initialized data (copied by PM)
- *-----------------------------------------------------------------*/
-
- /* Data section. */
- .data :
- {
- *(.data)
- *(.data.*)
- *(.gnu.linkonce.d.*)
- SORT(CONSTRUCTORS)
- } > ram :ph_ram
-
- /* C++ constructor section. */
- .ctors :
- {
- __CTOR_LIST__ = .;
- *(.ctors)
- *(SORT(.ctors.*))
- __CTOR_END__ = .;
- } > ram :ph_ram
-
- /* C++ destructor section. */
- .dtors :
- {
- __DTOR_LIST__ = .;
- *(.dtors)
- *(SORT(.dtors.*))
- __DTOR_END__ = .;
- } > ram :ph_ram
-
-
- /* Small data section. */
- .sdata ALIGN(0x10) :
- {
- PROVIDE (_SDA_BASE_ = .);
- *(.sdata)
- *(.sdata.*)
- *(.gnu.linkonce.s.*)
- } > ram :ph_ram
-
- /*-------------------------------------------------------------------
- * Uninitialized data (cleared by PM)
- *-----------------------------------------------------------------*/
-
- /* Small bss section. */
- .sbss :
- {
- *(.sbss)
- *(.sbss.*)
- *(.scommon)
- *(.gnu.linkonce.sb.*)
- } > ram :ph_ram
-
- /* Bss section. */
- .bss :
- {
- *(.bss)
- *(.bss.*)
- *(COMMON)
- *(.gnu.linkonce.b.*)
- } > ram :ph_ram
-
-/*---------------------------------------------------------------------------
- * Debug information
- *-------------------------------------------------------------------------*/
-
- /*
- * Stabs debug sections.
- */
-
- .stab 0 : { *(.stab) }
- .stabstr 0 : { *(.stabstr) }
- .stab.excl 0 : { *(.stab.excl) }
- .stab.exclstr 0 : { *(.stab.exclstr) }
- .stab.index 0 : { *(.stab.index) }
- .stab.indexstr 0 : { *(.stab.indexstr) }
- .comment 0 : { *(.comment) }
-
- /*
- * DWARF debug sections.
- */
-
- /* DWARF 1 */
- .debug 0 : { *(.debug) }
- .line 0 : { *(.line) }
- /* GNU DWARF 1 extensions */
- .debug_srcinfo 0 : { *(.debug_srcinfo) }
- .debug_sfnames 0 : { *(.debug_sfnames) }
- /* DWARF 1.1 and DWARF 2 */
- .debug_aranges 0 : { *(.debug_aranges) }
- .debug_pubnames 0 : { *(.debug_pubnames) }
- /* DWARF 2 */
- .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) }
- .debug_abbrev 0 : { *(.debug_abbrev) }
- .debug_line 0 : { *(.debug_line) }
- .debug_frame 0 : { *(.debug_frame) }
- .debug_str 0 : { *(.debug_str) }
- .debug_loc 0 : { *(.debug_loc) }
- .debug_macinfo 0 : { *(.debug_macinfo) }
- /* SGI/MIPS DWARF 2 extensions */
- .debug_weaknames 0 : { *(.debug_weaknames) }
- .debug_funcnames 0 : { *(.debug_funcnames) }
- .debug_typenames 0 : { *(.debug_typenames) }
- .debug_varnames 0 : { *(.debug_varnames) }
-}
diff --git a/erts/emulator/sys/ose/sys.c b/erts/emulator/sys/ose/sys.c
deleted file mode 100644
index bcd0ffa0b6..0000000000
--- a/erts/emulator/sys/ose/sys.c
+++ /dev/null
@@ -1,1847 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-#include "sys/time.h"
-#include "time.h"
-#include "sys/uio.h"
-#include "termios.h"
-#include "ctype.h"
-#include "termios.h"
-
-#ifdef HAVE_FCNTL_H
-#include "fcntl.h"
-#endif
-
-#ifdef HAVE_SYS_IOCTL_H
-#include "sys/ioctl.h"
-#endif
-
-#define ERTS_WANT_BREAK_HANDLING
-#define WANT_NONBLOCKING
-#include "sys.h"
-#include "erl_thr_progress.h"
-
-#ifdef USE_THREADS
-#include "erl_threads.h"
-#endif
-
-#include "erl_mseg.h"
-
-#include "unistd.h"
-#include "efs.h"
-#include "erl_printf.h"
-#include "aio.h"
-#include "pm.h"
-#include "fcntl.h"
-
-/* Set the define to 1 to get some logging */
-#if 0
-#include "ramlog.h"
-#define LOG(output) ramlog_printf output
-#else
-#define LOG(output)
-#endif
-
-extern char **environ;
-static erts_smp_rwmtx_t environ_rwmtx;
-static PROCESS sig_proxy_pid = 0;
-
-#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O
- * vector sock_sendv().
- */
-/*
- * Don't need global.h, but bif_table.h (included by bif.h),
- * won't compile otherwise
- */
-#include "global.h"
-#include "bif.h"
-
-#include "erl_sys_driver.h"
-#include "erl_check_io.h"
-#include "erl_cpu_topology.h"
-
-/* The priority for reader/writer processes */
-#define FD_PROC_PRI get_pri(current_process())
-
-typedef struct ErtsSysReportExit_ ErtsSysReportExit;
-struct ErtsSysReportExit_ {
- ErtsSysReportExit *next;
- Eterm port;
- int pid;
- int ifd;
- int ofd;
- ErlDrvEvent attach_event;
- ErlDrvEvent input_event;
- ErlDrvEvent output_event;
-};
-
-/* This data is shared by these drivers - initialized by spawn_init() */
-static struct driver_data {
- ErlDrvPort port_num;
- int ofd;
- int ifd;
- int packet_bytes;
- ErtsSysReportExit *report_exit;
- int pid;
- int alive;
- int status;
- ErlDrvEvent input_event;
- ErlDrvEvent output_event;
- struct aiocb aiocb;
- FmHandle handle;
- char *install_handle;
-} *driver_data; /* indexed by fd */
-
-struct async {
- SIGSELECT signo;
- ErlDrvTermData port;
- ErlDrvTermData proc;
- PROCESS spid;
- PROCESS target;
- Uint32 ref;
-};
-
-static ErtsSysReportExit *report_exit_list;
-static ERTS_INLINE void report_exit_status(ErtsSysReportExit *rep, int status);
-
-extern int driver_interrupt(int, int);
-extern void do_break(void);
-
-extern void erl_sys_args(int*, char**);
-
-/* The following two defs should probably be moved somewhere else */
-
-extern void erts_sys_init_float(void);
-
-extern void erl_crash_dump(char* file, int line, char* fmt, ...);
-
-#define DIR_SEPARATOR_CHAR '/'
-
-#if defined(DEBUG)
-#define ERL_BUILD_TYPE_MARKER ".debug"
-#else /* opt */
-#define ERL_BUILD_TYPE_MARKER
-#endif
-
-#define CHILD_SETUP_PROG_NAME "child_setup" ERL_BUILD_TYPE_MARKER
-
-#ifdef DEBUG
-static int debug_log = 0;
-#endif
-
-#ifdef ERTS_SMP
-static erts_smp_atomic32_t have_prepared_crash_dump;
-#define ERTS_PREPARED_CRASH_DUMP \
- ((int) erts_smp_atomic32_xchg_nob(&have_prepared_crash_dump, 1))
-#else
-static volatile int have_prepared_crash_dump;
-#define ERTS_PREPARED_CRASH_DUMP \
- (have_prepared_crash_dump++)
-#endif
-
-static erts_smp_atomic_t sys_misc_mem_sz;
-
-#if defined(ERTS_SMP)
-erts_mtx_t chld_stat_mtx;
-#endif
-
-#if defined(ERTS_SMP) /* ------------------------------------------------- */
-#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx)
-#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx)
-
-#else /* ------------------------------------------------------------------- */
-#define CHLD_STAT_LOCK
-#define CHLD_STAT_UNLOCK
-static volatile int children_died;
-#endif
-
-#define SET_AIO(REQ,FD,SIZE,BUFF) \
- memset(&(REQ),0,sizeof(REQ)); \
- (REQ).aio_fildes = FD; \
- (REQ).aio_offset = FM_POSITION_CURRENT; \
- (REQ).aio_nbytes = SIZE; \
- (REQ).aio_buf = BUFF; \
- (REQ).aio_sigevent.sigev_notify = SIGEV_NONE
-
-/* the first sizeof(struct aiocb *) bytes of the write buffer
- * will contain the pointer to the aiocb struct, this needs
- * to be freed between asynchronous writes.
- * A write of 0 bytes is ignored. */
-#define WRITE_AIO(FD,SIZE,BUFF) do { \
- if (SIZE > 0) { \
- struct aiocb *write_req = driver_alloc(sizeof(struct aiocb)); \
- char *write_buff = driver_alloc((sizeof(char)*SIZE)+1+ \
- (sizeof(struct aiocb *))); \
- *(struct aiocb **)write_buff = (struct aiocb *)write_req; \
- write_buff += sizeof(struct aiocb *); \
- memcpy(write_buff,BUFF,SIZE+1); \
- SET_AIO(*write_req,FD,SIZE,write_buff); \
- if (aio_write(write_req)) \
- ramlog_printf("%s:%d: write failed with %d\n", \
- __FILE__,__LINE__,errno); \
- } \
-} while(0)
-
-/* free the write_buffer and write_req
- * created in the WRITE_AIO() request macro */
-#define FREE_AIO(ptr) do { \
- struct aiocb *aiocb_ptr; \
- char *buffer_ptr; \
- aiocb_ptr = *(struct aiocb **)((ptr)-sizeof(struct aiocb *)); \
- buffer_ptr = (((char*)ptr)-sizeof(struct aiocb *)); \
- driver_free(aiocb_ptr); \
- driver_free(buffer_ptr); \
-} while(0)
-
-#define DISPATCH_AIO(sig) do { \
- if (aio_dispatch(sig)) \
- ramlog_printf("%s:%d: dispatch failed with %d\n", \
- __FILE__,__LINE__,errno); \
- } while(0)
-
-#define AIO_PIPE_SIZE 1024
-
-/* debug print macros */
-#define DEBUG_RES 0
-
-#ifdef DEBUG_RES
-#define DEBUG_CHECK_RES(actual, expected) \
- do { \
- if (actual != expected ) { \
- ramlog_printf("Result check failed" \
- " got: 0x%08x expected:0x%08x\nat: %s:%d\n", \
- actual, expected, __FILE__, __LINE__); \
- abort(); /* This might perhaps be too harsh? */ \
- } \
- } while(0)
-#else
-#define DEBUG_CHECK_RES
-#endif
-
-static struct fd_data {
- char pbuf[4]; /* hold partial packet bytes */
- int psz; /* size of pbuf */
- char *buf;
- char *cpos;
- int sz;
- int remain; /* for input on fd */
-} *fd_data; /* indexed by fd */
-
-/********************* General functions ****************************/
-
-/* This is used by both the drivers and general I/O, must be set early */
-static int max_files = -1;
-
-/*
- * a few variables used by the break handler
- */
-#ifdef ERTS_SMP
-erts_smp_atomic32_t erts_break_requested;
-#define ERTS_SET_BREAK_REQUESTED \
- erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 1)
-#define ERTS_UNSET_BREAK_REQUESTED \
- erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 0)
-#else
-volatile int erts_break_requested = 0;
-#define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1)
-#define ERTS_UNSET_BREAK_REQUESTED (erts_break_requested = 0)
-#endif
-/* set early so the break handler has access to initial mode */
-static struct termios initial_tty_mode;
-static int replace_intr = 0;
-/* assume yes initially, ttsl_init will clear it */
-int using_oldshell = 1;
-static PROCESS get_signal_proxy_pid(void);
-
-static void
-init_check_io(void)
-{
- erts_init_check_io();
- max_files = erts_check_io_max_files();
-}
-
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-#define ERTS_CHK_IO_AS_INTR() erts_check_io_async_sig_interrupt()
-#else
-#define ERTS_CHK_IO_AS_INTR() erts_check_io_interrupt(1)
-#endif
-#define ERTS_CHK_IO_INTR erts_check_io_interrupt
-#define ERTS_CHK_IO_INTR_TMD erts_check_io_interrupt_timed
-#define ERTS_CHK_IO erts_check_io
-#define ERTS_CHK_IO_SZ erts_check_io_size
-
-
-void
-erts_sys_schedule_interrupt(int set)
-{
- ERTS_CHK_IO_INTR(set);
-}
-
-#ifdef ERTS_SMP
-void
-erts_sys_schedule_interrupt_timed(int set, ErtsMonotonicTime timeout_time)
-{
- ERTS_CHK_IO_INTR_TMD(set, timeout_time);
-}
-#endif
-
-Uint
-erts_sys_misc_mem_sz(void)
-{
- Uint res = ERTS_CHK_IO_SZ();
- res += erts_smp_atomic_read_mb(&sys_misc_mem_sz);
- return res;
-}
-
-/*
- * reset the terminal to the original settings on exit
- */
-void sys_tty_reset(int exit_code)
-{
- if (using_oldshell && !replace_intr) {
- SET_BLOCKING(0);
- }
- else if (isatty(0)) {
- tcsetattr(0,TCSANOW,&initial_tty_mode);
- }
-}
-
-#ifdef USE_THREADS
-
-typedef struct {
- int sched_bind_data;
-} erts_thr_create_data_t;
-
-/*
- * thr_create_prepare() is called in parent thread before thread creation.
- * Returned value is passed as argument to thr_create_cleanup().
- */
-static void *
-thr_create_prepare(void)
-{
- erts_thr_create_data_t *tcdp;
-
- tcdp = erts_alloc(ERTS_ALC_T_TMP, sizeof(erts_thr_create_data_t));
-
- tcdp->sched_bind_data = erts_sched_bind_atthrcreate_prepare();
-
- return (void *) tcdp;
-}
-
-
-/* thr_create_cleanup() is called in parent thread after thread creation. */
-static void
-thr_create_cleanup(void *vtcdp)
-{
- erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp;
-
- erts_sched_bind_atthrcreate_parent(tcdp->sched_bind_data);
-
- erts_free(ERTS_ALC_T_TMP, tcdp);
-}
-
-static void
-thr_create_prepare_child(void *vtcdp)
-{
- erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp;
-
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_thread_setup();
-#endif
-
- erts_sched_bind_atthrcreate_child(tcdp->sched_bind_data);
-}
-
-#endif /* #ifdef USE_THREADS */
-
-/* The two functions below are stolen from win_con.c
- They have to use malloc/free/realloc directly becasue
- we want to do able to do erts_printf very early on.
- */
-#define VPRINTF_BUF_INC_SIZE 128
-static erts_dsprintf_buf_t *
-grow_vprintf_buf(erts_dsprintf_buf_t *dsbufp, size_t need)
-{
- char *buf;
- size_t size;
-
- ASSERT(dsbufp);
-
- if (!dsbufp->str) {
- size = (((need + VPRINTF_BUF_INC_SIZE - 1)
- / VPRINTF_BUF_INC_SIZE)
- * VPRINTF_BUF_INC_SIZE);
- buf = (char *) malloc(size * sizeof(char));
- }
- else {
- size_t free_size = dsbufp->size - dsbufp->str_len;
-
- if (need <= free_size)
- return dsbufp;
-
- size = need - free_size + VPRINTF_BUF_INC_SIZE;
- size = (((size + VPRINTF_BUF_INC_SIZE - 1)
- / VPRINTF_BUF_INC_SIZE)
- * VPRINTF_BUF_INC_SIZE);
- size += dsbufp->size;
- buf = (char *) realloc((void *) dsbufp->str,
- size * sizeof(char));
- }
- if (!buf)
- return NULL;
- if (buf != dsbufp->str)
- dsbufp->str = buf;
- dsbufp->size = size;
- return dsbufp;
-}
-
-static int erts_sys_ramlog_printf(char *format, va_list arg_list)
-{
- int res,i;
- erts_dsprintf_buf_t dsbuf = ERTS_DSPRINTF_BUF_INITER(grow_vprintf_buf);
- res = erts_vdsprintf(&dsbuf, format, arg_list);
- if (res >= 0) {
- for (i = 0; i < dsbuf.str_len; i+= 50)
- /* We print 50 characters at a time because otherwise
- the ramlog looks broken */
- ramlog_printf("%.*s",dsbuf.str_len-50 < 0?dsbuf.str_len:50,dsbuf.str+i);
- }
- if (dsbuf.str)
- free((void *) dsbuf.str);
- return res;
-}
-
-void
-erts_sys_pre_init(void)
-{
- erts_printf_add_cr_to_stdout = 1;
- erts_printf_add_cr_to_stderr = 1;
-#ifdef USE_THREADS
- {
- erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER;
-
- eid.thread_create_child_func = thr_create_prepare_child;
- /* Before creation in parent */
- eid.thread_create_prepare_func = thr_create_prepare;
- /* After creation in parent */
- eid.thread_create_parent_func = thr_create_cleanup,
-
- erts_thr_init(&eid);
-
- report_exit_list = NULL;
-
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init();
-#endif
-
-#if defined(ERTS_SMP)
- erts_mtx_init(&chld_stat_mtx, "child_status");
-#endif
- }
-#ifdef ERTS_SMP
- erts_smp_atomic32_init_nob(&erts_break_requested, 0);
- erts_smp_atomic32_init_nob(&have_prepared_crash_dump, 0);
-#else
- erts_break_requested = 0;
- have_prepared_crash_dump = 0;
-#endif
-#if !defined(ERTS_SMP)
- children_died = 0;
-#endif
-#endif /* USE_THREADS */
-
- erts_printf_stdout_func = erts_sys_ramlog_printf;
-
- erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0);
-}
-
-void
-erl_sys_init(void)
-{
-
-#ifdef USE_SETLINEBUF
- setlinebuf(stdout);
-#else
- setvbuf(stdout, (char *)NULL, _IOLBF, BUFSIZ);
-#endif
-
- erts_sys_init_float();
-
- /* we save this so the break handler can set and reset it properly */
- /* also so that we can reset on exit (break handler or not) */
- if (isatty(0)) {
- tcgetattr(0,&initial_tty_mode);
- }
- tzset(); /* Required at least for NetBSD with localtime_r() */
-}
-
-static ERTS_INLINE int
-prepare_crash_dump(int secs)
-{
-#define NUFBUF (3)
- int i, max;
- char env[21]; /* enough to hold any 64-bit integer */
- size_t envsz;
- /*DeclareTmpHeapNoproc(heap,NUFBUF);*/
- /*Eterm *hp = heap;*/
- /*Eterm list = NIL;*/
- int has_heart = 0;
-
- UseTmpHeapNoproc(NUFBUF);
-
- if (ERTS_PREPARED_CRASH_DUMP)
- return 0; /* We have already been called */
-
-
- /* Positive secs means an alarm must be set
- * 0 or negative means no alarm
- *
- * Set alarm before we try to write to a port
- * we don't want to hang on a port write with
- * no alarm.
- *
- */
-
-#if 0 /*ose TBD!!!*/
- if (secs >= 0) {
- alarm((unsigned int)secs);
- }
-#endif
-
- /* Make sure we unregister at epmd (unknown fd) and get at least
- one free filedescriptor (for erl_crash.dump) */
-
- max = max_files;
- if (max < 1024)
- max = 1024;
- for (i = 3; i < max; i++) {
- close(i);
- }
-
- envsz = sizeof(env);
- i = erts_sys_getenv__("ERL_CRASH_DUMP_NICE", env, &envsz);
- if (i >= 0) {
- int nice_val;
- nice_val = i != 0 ? 0 : atoi(env);
- if (nice_val > 39) {
- nice_val = 39;
- }
- set_pri(nice_val);
- }
-
- UnUseTmpHeapNoproc(NUFBUF);
-#undef NUFBUF
- return has_heart;
-}
-
-int erts_sys_prepare_crash_dump(int secs)
-{
- return prepare_crash_dump(secs);
-}
-
-static ERTS_INLINE void
-break_requested(void)
-{
- /*
- * just set a flag - checked for and handled by
- * scheduler threads erts_check_io() (not signal handler).
- */
-#ifdef DEBUG
- fprintf(stderr,"break!\n");
-#endif
- if (ERTS_BREAK_REQUESTED)
- erl_exit(ERTS_INTR_EXIT, "");
-
- ERTS_SET_BREAK_REQUESTED;
- ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
-}
-
-/* Disable break */
-void erts_set_ignore_break(void) {
-
-}
-
-/* Don't use ctrl-c for break handler but let it be
- used by the shell instead (see user_drv.erl) */
-void erts_replace_intr(void) {
- struct termios mode;
-
- if (isatty(0)) {
- tcgetattr(0, &mode);
-
- /* here's an example of how to replace ctrl-c with ctrl-u */
- /* mode.c_cc[VKILL] = 0;
- mode.c_cc[VINTR] = CKILL; */
-
- mode.c_cc[VINTR] = 0; /* disable ctrl-c */
- tcsetattr(0, TCSANOW, &mode);
- replace_intr = 1;
- }
-}
-
-void init_break_handler(void)
-{
-
-}
-
-int sys_max_files(void)
-{
- return(max_files);
-}
-
-
-/************************** OS info *******************************/
-
-/* Used by erlang:info/1. */
-/* (This code was formerly in drv.XXX/XXX_os_drv.c) */
-
-char os_type[] = "ose";
-
-void
-os_flavor(char* namebuf, /* Where to return the name. */
- unsigned size) /* Size of name buffer. */
-{
-#if 0
- struct utsname uts; /* Information about the system. */
- char* s;
-
- (void) uname(&uts);
- for (s = uts.sysname; *s; s++) {
- if (isupper((int) *s)) {
- *s = tolower((int) *s);
- }
- }
- strcpy(namebuf, uts.sysname);
-#else
- strncpy(namebuf, "release", size);
-#endif
-}
-
-void
-os_version(pMajor, pMinor, pBuild)
-int* pMajor; /* Pointer to major version. */
-int* pMinor; /* Pointer to minor version. */
-int* pBuild; /* Pointer to build number. */
-{
- *pMajor = 5;
- *pMinor = 7;
- *pBuild = 0;
-}
-
-void init_getenv_state(GETENV_STATE *state)
-{
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- *state = NULL;
-}
-
-char **environ; /*ose - needs replacement*/
-
-char *getenv_string(GETENV_STATE *state0)
-{
- char **state = (char **) *state0;
- char *cp;
-
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx));
-
- if (state == NULL)
- state = environ;
-
- cp = *state++;
- *state0 = (GETENV_STATE) state;
-
- return cp;
-}
-
-void fini_getenv_state(GETENV_STATE *state)
-{
- *state = NULL;
- erts_smp_rwmtx_runlock(&environ_rwmtx);
-}
-
-
-/************************** Port I/O *******************************/
-
-/* I. Common stuff */
-
-union SIGNAL {
- SIGSELECT sig_no;
- struct FmReadPtr fm_read_reply;
- struct FmWritePtr fm_write_reply;
- struct async async;
-};
-
-/* II. The spawn/fd drivers */
-
-/*
- * Decreasing the size of it below 16384 is not allowed.
- */
-#define ERTS_SYS_READ_BUF_SZ (64*1024)
-
-/* Driver interfaces */
-static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*);
-static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*);
-static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT,
- char **, ErlDrvSizeT);
-static int spawn_init(void);
-static void fd_stop(ErlDrvData);
-static void erl_stop(ErlDrvData);
-static void ready_input(ErlDrvData, ErlDrvEvent);
-static void ready_output(ErlDrvData, ErlDrvEvent);
-static void output(ErlDrvData, char*, ErlDrvSizeT);
-static void stop_select(ErlDrvEvent, void*);
-
-static PROCESS
-get_signal_proxy_pid(void) {
- union SIGNAL *sig;
- SIGSELECT any_sig[] = {1,ERTS_SIGNAL_OSE_DRV_ATTACH};
-
- if (!sig_proxy_pid) {
- sig = alloc(sizeof(union SIGNAL), ERTS_SIGNAL_OSE_DRV_ATTACH);
- hunt("ose_signal_driver_proxy", 0, NULL, &sig);
- sig = receive(any_sig);
- sig_proxy_pid = sender(&sig);
- free_buf(&sig);
- }
- ASSERT(sig_proxy_pid);
- return sig_proxy_pid;
-}
-
-static ErlDrvOseEventId
-resolve_signal(union SIGNAL* sig) {
- switch(sig->sig_no) {
-
- case FM_READ_PTR_REPLY:
- return (ErlDrvOseEventId)sig->fm_read_reply.handle;
-
- case FM_WRITE_PTR_REPLY:
- return (ErlDrvOseEventId)sig->fm_write_reply.handle;
-
- case ERTS_SIGNAL_OSE_DRV_ATTACH:
- return (ErlDrvOseEventId)sig->async.target;
-
- default:
- break;
- }
- return (ErlDrvOseEventId)-1;
-}
-
-struct erl_drv_entry spawn_driver_entry = {
- spawn_init,
- spawn_start,
- NULL, /* erl_stop, */
- output,
- ready_input,
- ready_output,
- "spawn",
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- ERL_DRV_FLAG_USE_PORT_LOCKING,
- NULL, NULL,
- stop_select
-};
-struct erl_drv_entry fd_driver_entry = {
- NULL,
- fd_start,
- fd_stop,
- output,
- ready_input,
- ready_output,
- "fd",
- NULL,
- NULL,
- fd_control,
- NULL,
- NULL,
- NULL, /* ready_async */
- NULL, /* flush */
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0, /* ERL_DRV_FLAGs */
- NULL, /* handle2 */
- NULL, /* process_exit */
- stop_select
-};
-
-static void
-set_spawn_fd(int local_fd, int remote_fd, PROCESS remote_pid) {
- PROCESS vm_pid;
- FmHandle handle;
- char env_val[55];
- char env_name[10];
- EfsStatus efs_res;
-
- /* get pid of pipevm and handle of chosen fd */
- efs_res = efs_examine_fd(local_fd, FLIB_FD_VMPID, &vm_pid, 0);
- DEBUG_CHECK_RES(efs_res, EFS_SUCCESS);
-
- /* setup the file descriptor to buffer per line */
- efs_res = efs_config_fd(local_fd, FLIB_FD_BUFMODE, FM_BUFF_LINE,
- FLIB_FD_BUFSIZE, 80, 0);
- DEBUG_CHECK_RES(efs_res, EFS_SUCCESS);
-
- /* duplicate handle and set spawn pid owner */
- efs_res = efs_dup_to(local_fd, remote_pid, &handle);
- DEBUG_CHECK_RES(efs_res, EFS_SUCCESS);
-
- sprintf(env_name, "FD%d", remote_fd);
-
- /* Syntax of the environment variable:
- * "FD#" "<pid of pipevm>,<handle>,<buffer mode>,<buff size>,<omode>" */
- sprintf(env_val, "0x%lx,0x%lx,%lu,%lu,0x%x",
- vm_pid, handle,
- FM_BUFF_LINE, 80,
- O_APPEND);
-
- set_env(remote_pid, env_name, env_val);
-}
-
-static ErlDrvData
-set_driver_data(ErlDrvPort port_num,
- int ifd,
- int ofd,
- int packet_bytes,
- int read_write,
- int exit_status,
- PROCESS pid)
-{
- Port *prt;
- ErtsSysReportExit *report_exit;
-
- prt = erts_drvport2port(port_num);
- if (prt != ERTS_INVALID_ERL_DRV_PORT) {
- prt->os_pid = pid;
- }
-
- /* READ */
- if (read_write & DO_READ) {
- EfsStatus res = efs_examine_fd(ifd, FLIB_FD_HANDLE,
- &driver_data[ifd].handle, 0);
- if (res != EFS_SUCCESS)
- ramlog_printf("%s:%d: efs_examine_fd(%d) failed with %d\n",
- __FILE__,__LINE__,ifd,errno);
- driver_data[ifd].ifd = ifd;
- driver_data[ifd].packet_bytes = packet_bytes;
- driver_data[ifd].port_num = port_num;
- driver_data[ifd].pid = pid;
-
- /* async read struct */
- memset(&driver_data[ifd].aiocb, 0, sizeof(struct aiocb));
- driver_data[ifd].aiocb.aio_buf = driver_alloc(AIO_PIPE_SIZE);
- driver_data[ifd].aiocb.aio_fildes = ifd;
- driver_data[ifd].aiocb.aio_nbytes = (packet_bytes?packet_bytes:AIO_PIPE_SIZE);
- driver_data[ifd].alive = 1;
- driver_data[ifd].status = 0;
- driver_data[ifd].input_event =
- erl_drv_ose_event_alloc(FM_READ_PTR_REPLY,
- driver_data[ifd].handle, resolve_signal,
- &driver_data[ifd].ifd);
-
- /* READ & WRITE */
- if (read_write & DO_WRITE) {
- driver_data[ifd].ofd = ofd;
- efs_examine_fd(ofd, FLIB_FD_HANDLE, &driver_data[ofd].handle, 0);
-
- driver_data[ifd].output_event =
- erl_drv_ose_event_alloc(FM_WRITE_PTR_REPLY,
- driver_data[ofd].handle, resolve_signal,
- &driver_data[ofd].ofd);
- driver_data[ofd].pid = pid;
- if (ifd != ofd) {
- driver_data[ofd] = driver_data[ifd];
- driver_data[ofd].aiocb.aio_buf = NULL;
- }
- }
- else { /* READ ONLY */
- driver_data[ifd].ofd = -1;
- }
-
- /* enable input event */
- (void) driver_select(port_num, driver_data[ifd].input_event,
- (ERL_DRV_READ | ERL_DRV_USE), 1);
-
- if (aio_read(&driver_data[ifd].aiocb))
- ramlog_printf("%s:%d: aio_read(%d) failed with %d\n",
- __FILE__,__LINE__,ifd,errno);
- }
- else { /* WRITE ONLY */
- efs_examine_fd(ofd, FLIB_FD_HANDLE, &driver_data[ofd].handle, 0);
- driver_data[ofd].packet_bytes = packet_bytes;
- driver_data[ofd].port_num = port_num;
- driver_data[ofd].ofd = ofd;
- driver_data[ofd].pid = pid;
- driver_data[ofd].alive = 1;
- driver_data[ofd].status = 0;
- driver_data[ofd].output_event =
- erl_drv_ose_event_alloc(FM_WRITE_PTR_REPLY, driver_data[ofd].handle,
- resolve_signal, &driver_data[ofd].ofd);
- driver_data[ofd].input_event = driver_data[ofd].output_event;
- }
-
- /* this is used for spawned load modules, and is needed
- * to properly uninstall them */
- if (exit_status) {
- struct PmProgramInfo *info;
- int install_handle_size;
- union SIGNAL *sig;
- PmStatus pm_status;
- report_exit = erts_alloc(ERTS_ALC_T_PRT_REP_EXIT,
- sizeof(ErtsSysReportExit));
- report_exit->next = report_exit_list;
- report_exit->port = erts_drvport2id(port_num);
- report_exit->pid = pid;
- report_exit->ifd = (read_write & DO_READ) ? ifd : -1;
- report_exit->ofd = (read_write & DO_WRITE) ? ofd : -1;
- report_exit_list = report_exit;
- report_exit->attach_event =
- erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_ATTACH, pid,
- resolve_signal, &driver_data[ifd].ifd);
-
- /* setup ifd and ofd report exit */
- driver_data[ifd].report_exit = report_exit;
- driver_data[ofd].report_exit = report_exit;
-
- pm_status = ose_pm_program_info(pid, &info);
- DEBUG_CHECK_RES(pm_status, PM_SUCCESS);
-
- install_handle_size = strlen(info->install_handle)+1;
- driver_data[ifd].install_handle = driver_alloc(install_handle_size);
- strcpy(driver_data[ifd].install_handle,
- info->install_handle);
-
- free_buf((union SIGNAL **)&info);
-
- sig = alloc(sizeof(struct async), ERTS_SIGNAL_OSE_DRV_ATTACH);
- sig->async.target = pid;
- send(&sig, get_signal_proxy_pid());
-
- /* this event will trigger when we receive an attach signal
- * from the recently dead load module */
- (void)driver_select(port_num,report_exit->attach_event, DO_READ, 1);
- }
- else {
- report_exit = NULL;
- }
-
- /* the return value is the pointer to the driver_data struct we created
- * in this function, it will be used in the drivers input
- * and output functions */
- return (ErlDrvData)((!(read_write & DO_READ) && read_write & DO_WRITE)
- ? &driver_data[ofd]
- : &driver_data[ifd]);
-}
-
-static int spawn_init()
-{
- int i;
-
- driver_data = (struct driver_data *)
- erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data));
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
- max_files * sizeof(struct driver_data));
-
- for (i = 0; i < max_files; i++)
- driver_data[i].pid = -1;
-
- return 1;
-}
-
-static void
-init_fd_data(int fd, ErlDrvPort port_num)
-{
- fd_data[fd].buf = NULL;
- fd_data[fd].cpos = NULL;
- fd_data[fd].remain = 0;
- fd_data[fd].sz = 0;
- fd_data[fd].psz = 0;
-}
-
-/* FIXME write a decent text on pipes on ose */
-static ErlDrvData
-spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts)
-{
- int ifd[2];
- int ofd[2];
- static uint32_t ticker = 1;
- PmStatus pm_status;
- OSDOMAIN domain = PM_NEW_DOMAIN;
- PROCESS progpid, mainbid, mainpid;
- char *handle = NULL;
- struct PmProgramInfo *info;
- char *args = NULL;
- char *tmp_handle;
- ErlDrvData res = (ErlDrvData)-1;
- int handle_size;
- char *ptr;
-
-
- args = driver_alloc(strlen(name)+1);
- strcpy(args, name);
- /* We need to handle name in three parts
- * - install handle (must be unique)
- * - install binary (needed for ose_pm_install_load_module())
- * - full path (as argument to the spawned applications env.var
- */
-
- /* full path including arguments */
- args = driver_alloc(strlen(name)+1);
- strcpy(args, name);
-
- /* handle path */
- tmp_handle = strrchr(name, '/');
- if (tmp_handle == NULL) {
- tmp_handle = name;
- }
- else {
- tmp_handle++;
- }
-
- /* handle args */
- ptr = strchr(tmp_handle, ' ');
- if (ptr != NULL) {
- *ptr = '\0';
- handle_size = ptr - tmp_handle;
- }
- else {
- handle_size = strlen(name)+1;
- }
-
- /* make room for ticker */
- handle_size += (ticker<10)?3:((ticker<100)?4:5);
- handle = driver_alloc(handle_size);
-
- do {
- snprintf(handle, handle_size, "%s_%d", tmp_handle, ticker);
- pm_status = ose_pm_install_load_module(0, "ELF", name, handle,
- 0, 0, NULL);
- ticker++;
- } while (pm_status == PM_EINSTALL_HANDLE_ALREADY_INSTALLED);
-
- if (pm_status != PM_SUCCESS) {
- errno = ENOSYS; /* FIXME add comment */
- return ERL_DRV_ERROR_ERRNO;
- }
-
- /* Create Program */
- pm_status = ose_pm_create_program(&domain, handle, 0, 0,
- NULL, &progpid, &mainbid);
- DEBUG_CHECK_RES(pm_status, PM_SUCCESS);
-
- /* Get the mainpid from the newly created program */
- pm_status = ose_pm_program_info(progpid, &info);
- DEBUG_CHECK_RES(pm_status, PM_SUCCESS);
-
- mainpid = info->main_process;
- free_buf ((union SIGNAL **)&info);
-
- /* pipevm needs to be started
- * pipe will return 0 if success, -1 if not,
- * errno will be set */
- if (pipe(ifd) != 0 || pipe(ofd) != 0) {
- DEBUG_CHECK_RES(0, -1);
- ASSERT(0);
- }
-
- /* setup driver data */
- res = set_driver_data(port_num, ofd[0], ifd[1], opts->packet_bytes,
- opts->read_write, 1 /* opts->exit_status */, progpid);
-
- /* init the fd_data array for read/write */
- init_fd_data(ofd[0], port_num);
- init_fd_data(ifd[1], port_num);
-
- /* setup additional configurations
- * for the spawned applications environment */
- if (args != NULL) {
- set_env(progpid, "ARGV", args);
- }
- set_env(mainbid, "EFS_RESOLVE_TMO", 0);
- set_spawn_fd(ifd[0], 0, mainpid);
- set_spawn_fd(ofd[1], 1, mainpid);
- set_spawn_fd(ofd[1], 2, mainpid);
-
- /* start the spawned program */
- pm_status = ose_pm_start_program(mainbid);
- DEBUG_CHECK_RES(pm_status, PM_SUCCESS);
-
- /* close unused fd's */
- close(ifd[0]);
- close(ofd[1]);
-
- if (handle) {
- driver_free(handle);
- }
-
- return (ErlDrvData)res;
-}
-
-#define FD_DEF_HEIGHT 24
-#define FD_DEF_WIDTH 80
-/* Control op */
-#define FD_CTRL_OP_GET_WINSIZE 100
-
-static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height)
-{
-#ifdef TIOCGWINSZ
- struct winsize ws;
- if (ioctl(fd,TIOCGWINSZ,&ws) == 0) {
- *width = (Uint32) ws.ws_col;
- *height = (Uint32) ws.ws_row;
- return 0;
- }
-#endif
- return -1;
-}
-
-static ErlDrvSSizeT fd_control(ErlDrvData drv_data,
- unsigned int command,
- char *buf, ErlDrvSizeT len,
- char **rbuf, ErlDrvSizeT rlen)
-{
- struct driver_data *data = (struct driver_data *)drv_data;
- char resbuff[2*sizeof(Uint32)];
- switch (command) {
- case FD_CTRL_OP_GET_WINSIZE:
- {
- Uint32 w,h;
- if (fd_get_window_size(data->ifd,&w,&h))
- return 0;
- memcpy(resbuff,&w,sizeof(Uint32));
- memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32));
- }
- break;
- default:
- return 0;
- }
- if (rlen < 2*sizeof(Uint32)) {
- *rbuf = driver_alloc(2*sizeof(Uint32));
- }
- memcpy(*rbuf,resbuff,2*sizeof(Uint32));
- return 2*sizeof(Uint32);
-}
-
-static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
- SysDriverOpts* opts)
-{
- ErlDrvData res;
-
- CHLD_STAT_LOCK;
- if (opts->read_write & DO_READ) {
- init_fd_data(opts->ifd, port_num);
- }
- if (opts->read_write & DO_WRITE) {
- init_fd_data(opts->ofd, port_num);
- }
- res = set_driver_data(port_num, opts->ifd, opts->ofd,
- opts->packet_bytes,
- opts->read_write, 0, -1);
- CHLD_STAT_UNLOCK;
- return res;
-}
-
-static void clear_fd_data(int fd)
-{
- if (fd_data[fd].sz > 0) {
- erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fd_data[fd].buf);
- ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fd_data[fd].sz);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fd_data[fd].sz);
- }
- fd_data[fd].buf = NULL;
- fd_data[fd].sz = 0;
- fd_data[fd].remain = 0;
- fd_data[fd].cpos = NULL;
- fd_data[fd].psz = 0;
-}
-
-static void nbio_stop_fd(ErlDrvPort prt, ErlDrvEvent ev)
-{
- int *fd;
- driver_select(prt,ev,DO_READ|DO_WRITE,0);
- erl_drv_ose_event_fetch(ev, NULL, NULL, (void **)&fd);
- clear_fd_data(*fd);
- SET_BLOCKING(*fd);
-}
-
-static void fd_stop(ErlDrvData drv_data) /* Does not close the fds */
-{
- struct driver_data *data = (struct driver_data *)drv_data;
-
- if (data->ofd != -1) {
- if (data->ifd != data->ofd) { /* read and write */
- nbio_stop_fd(data->port_num, data->input_event);
- nbio_stop_fd(data->port_num, data->output_event);
- }
- else { /* write only */
- nbio_stop_fd(data->port_num, data->output_event);
- }
- }
- else { /* read only */
- nbio_stop_fd(data->port_num, data->input_event);
- }
-}
-
-
-static void erl_stop(ErlDrvData drv_data)
-{
- struct driver_data *data = (struct driver_data *)drv_data;
-
- CHLD_STAT_LOCK;
- data->pid = -1;
- CHLD_STAT_UNLOCK;
-
- if (data->ofd != -1) {
- if (data->ifd != data->ofd) { /* read and write */
- nbio_stop_fd(data->port_num, data->input_event);
- nbio_stop_fd(data->port_num, data->output_event);
- }
- else { /* write only */
- nbio_stop_fd(data->port_num, data->output_event);
- }
- }
- else { /* read only */
- nbio_stop_fd(data->port_num, data->input_event);
- }
- close(data->ifd);
- close(data->ofd);
-}
-
-/* The parameter e is a pointer to the driver_data structure
- * related to the fd to be used as output */
-static void output(ErlDrvData drv_data, char* buf, ErlDrvSizeT len)
-{
- ErlDrvSizeT sz;
- char lb[4];
- char* lbp;
- struct driver_data *data = (struct driver_data *)drv_data;
-
- if (((data->packet_bytes == 2) &&
- (len > 0xffff)) || (data->packet_bytes == 1 && len > 0xff)) {
- driver_failure_posix(data->port_num, EINVAL);
- return; /* -1; */
- }
- put_int32(len, lb);
- lbp = lb + (4-(data->packet_bytes));
-
- if ((sz = driver_sizeq(data->port_num)) > 0) {
- if (data->packet_bytes != 0) {
- driver_enq(data->port_num, lbp, data->packet_bytes);
- }
- driver_enq(data->port_num, buf, len);
-
- if (sz + len + data->packet_bytes >= (1 << 13))
- set_busy_port(data->port_num, 1);
- }
- else {
- char *pbbuf;
- if (data->packet_bytes != 0) {
- pbbuf = malloc(len + data->packet_bytes);
- int i;
- for (i = 0; i < data->packet_bytes; i++) {
- *pbbuf++ = *lbp++;
- }
- strncpy(pbbuf, buf, len);
- pbbuf -= data->packet_bytes;
- }
- driver_select(data->port_num, data->output_event,
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
- WRITE_AIO(data->ofd,
- (data->packet_bytes ? len+data->packet_bytes : len),
- (data->packet_bytes ? pbbuf : buf));
- if (data->packet_bytes != 0) free(pbbuf);
- }
- return; /* 0; */
-}
-
-/* This function is being run when we in recieve
- * either a read of 0 bytes, or the attach signal from a dying
- * spawned load module */
-static int port_inp_failure(ErlDrvPort port_num, ErlDrvEvent ready_fd, int res)
- /* Result: 0 (eof) or -1 (error) */
-{
- int *fd;
- SIGSELECT sig_no;
- ASSERT(res <= 0);
-
- erl_drv_ose_event_fetch(ready_fd,&sig_no, NULL, (void **)&fd);
- /* As we need to handle two signals, we do this in two steps */
- if (driver_data[*fd].alive) {
- report_exit_status(driver_data[*fd].report_exit, 0); /* status? */
- }
- else {
- driver_select(port_num,ready_fd,DO_READ|DO_WRITE,0);
- clear_fd_data(*fd);
- driver_report_exit(driver_data[*fd].port_num, driver_data[*fd].status);
- /* As we do not really know if the spawn has crashed or exited nicely
- * we do not check the result status of the following call.. FIXME
- * can we handle this in a better way? */
- ose_pm_uninstall_load_module(driver_data[*fd].install_handle);
- driver_free(driver_data[*fd].install_handle);
- driver_free((void *)driver_data[*fd].aiocb.aio_buf);
-
- close(*fd);
- }
-
- return 0;
-}
-
-/* The parameter e is a pointer to the driver_data structure
- * related to the fd to be used as output.
- * ready_fd is the event that triggered this call to ready_input */
-static void ready_input(ErlDrvData drv_data, ErlDrvEvent ready_fd)
-{
- int res;
- Uint h;
- char *buf;
- union SIGNAL *sig;
- struct driver_data *data = (struct driver_data *)drv_data;
-
- sig = erl_drv_ose_get_signal(ready_fd);
- ASSERT(sig);
-
-
- while (sig) {
- /* If we've recieved an attach signal, we need to handle
- * it in port_inp_failure */
- if (sig->sig_no == ERTS_SIGNAL_OSE_DRV_ATTACH) {
- port_inp_failure(data->port_num, ready_fd, 0);
- }
- else {
- res = sig->fm_read_reply.actual;
- if (res == 0) {
- port_inp_failure(data->port_num, ready_fd, res);
- break;
- }
-
- if (data->packet_bytes == 0) {
- if (res < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
- port_inp_failure(data->port_num, ready_fd, res);
- }
- }
- else if (res == 0) {
- /* read of 0 bytes, eof, otherside of pipe is assumed dead */
- port_inp_failure(data->port_num, ready_fd, res);
- break;
- }
- else {
- buf = driver_alloc(res);
- memcpy(buf, (void *)data->aiocb.aio_buf, res);
- driver_select(data->port_num, data->output_event,
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
- driver_output(data->port_num, (char*) buf, res);
- driver_free(buf);
- }
- /* clear the previous read */
- memset(data->aiocb.aio_buf, 0, res);
-
- /* issue a new read */
- DISPATCH_AIO(sig);
- aio_read(&data->aiocb);
- }
- else if (data->packet_bytes && fd_data[data->ifd].remain > 0) {
- /* we've read a partial package, or a header */
-
- if (res == fd_data[data->ifd].remain) { /* we are done! */
- char *buf = data->aiocb.aio_buf;
- int i;
-
- /* do we have anything buffered? */
- if (fd_data[data->ifd].buf != NULL) {
- memcpy(fd_data[data->ifd].buf + fd_data[data->ifd].sz,
- buf, res);
- buf = fd_data[data->ifd].buf;
- }
-
- fd_data[data->ifd].sz += res;
- driver_output(data->port_num, buf, (fd_data[data->ifd].sz>0?fd_data[data->ifd].sz:res));
- clear_fd_data(data->ifd);
-
- /* clear the previous read */
- memset(data->aiocb.aio_buf, 0, res);
-
- /* issue a new read */
- DISPATCH_AIO(sig);
- data->aiocb.aio_nbytes = data->packet_bytes;
-
- if (data->aiocb.aio_buf == NULL) {
- port_inp_failure(data->port_num, ready_fd, -1);
- }
- aio_read(&data->aiocb);
- }
- else if(res < fd_data[data->ifd].remain) { /* received part of a package */
- if (fd_data[data->ifd].sz == 0) {
-
- fd_data[data->ifd].sz += res;
- memcpy(fd_data[data->ifd].buf, data->aiocb.aio_buf, res);
- fd_data[data->ifd].remain -= res;
- }
- else {
- memcpy(fd_data[data->ifd].buf + fd_data[data->ifd].sz,
- data->aiocb.aio_buf, res);
- fd_data[data->ifd].sz += res;
- fd_data[data->ifd].remain -= res;
- }
- /* clear the previous read */
- memset(data->aiocb.aio_buf, 0, res);
-
- /* issue a new read */
- DISPATCH_AIO(sig);
- data->aiocb.aio_nbytes = fd_data[data->ifd].remain;
-
- if (data->aiocb.aio_buf == NULL) {
- port_inp_failure(data->port_num, ready_fd, -1);
- }
- aio_read(&data->aiocb);
- }
- }
- else if (data->packet_bytes && fd_data[data->ifd].remain == 0) { /* we've recieved a header */
-
- /* analyze the header FIXME */
- switch (data->packet_bytes) {
- case 1: h = get_int8(data->aiocb.aio_buf); break;
- case 2: h = get_int16(data->aiocb.aio_buf); break;
- case 4: h = get_int32(data->aiocb.aio_buf); break;
- }
-
- fd_data[data->ifd].buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h + data->packet_bytes);
- fd_data[data->ifd].remain = ((h + data->packet_bytes) - res);
-
- /* clear the previous read */
- memset(data->aiocb.aio_buf, 0, data->packet_bytes);
-
- /* issue a new read */
- DISPATCH_AIO(sig);
- data->aiocb.aio_nbytes = h;
-
- if (data->aiocb.aio_buf == NULL) {
- port_inp_failure(data->port_num, ready_fd, -1);
- }
- aio_read(&data->aiocb);
- }
- }
- sig = erl_drv_ose_get_signal(ready_fd);
- }
-}
-
-
-/* The parameter e is a pointer to the driver_data structure
- * related to the fd to be used as output.
- * ready_fd is the event that triggered this call to ready_input */
-static void ready_output(ErlDrvData drv_data, ErlDrvEvent ready_fd)
-{
- SysIOVec *iov;
- int vlen;
- int res;
- union SIGNAL *sig;
- struct driver_data *data = (struct driver_data *)drv_data;
-
- sig = erl_drv_ose_get_signal(ready_fd);
- ASSERT(sig);
-
- while (sig != NULL) {
- if (sig->fm_write_reply.actual <= 0) {
- int status;
-
- status = efs_status_to_errno(sig->fm_write_reply.status);
- driver_select(data->port_num, ready_fd, ERL_DRV_WRITE, 0);
- DISPATCH_AIO(sig);
- FREE_AIO(sig->fm_write_reply.buffer);
-
- driver_failure_posix(data->port_num, status);
- }
- else { /* written bytes > 0 */
- iov = driver_peekq(data->port_num, &vlen);
- if (vlen > 0) {
- DISPATCH_AIO(sig);
- FREE_AIO(sig->fm_write_reply.buffer);
- res = driver_deq(data->port_num, iov[0].iov_len);
- if (res > 0) {
- iov = driver_peekq(data->port_num, &vlen);
- WRITE_AIO(data->ofd, iov[0].iov_len, iov[0].iov_base);
- }
- }
- else if (vlen == 0) {
- DISPATCH_AIO(sig);
- FREE_AIO(sig->fm_write_reply.buffer);
- }
-
- }
- sig = erl_drv_ose_get_signal(ready_fd);
- }
-}
-
-static void stop_select(ErlDrvEvent ready_fd, void* _)
-{
- int *fd;
- erl_drv_ose_event_fetch(ready_fd, NULL, NULL, (void **)&fd);
- erl_drv_ose_event_free(ready_fd);
- close(*fd);
-}
-
-
-void erts_do_break_handling(void)
-{
- struct termios temp_mode;
- int saved = 0;
-
- /*
- * Most functions that do_break() calls are intentionally not thread safe;
- * therefore, make sure that all threads but this one are blocked before
- * proceeding!
- */
- erts_smp_thr_progress_block();
-
- /* during break we revert to initial settings */
- /* this is done differently for oldshell */
- if (using_oldshell && !replace_intr) {
- SET_BLOCKING(1);
- }
- else if (isatty(0)) {
- tcgetattr(0,&temp_mode);
- tcsetattr(0,TCSANOW,&initial_tty_mode);
- saved = 1;
- }
-
- /* call the break handling function, reset the flag */
- do_break();
-
- fflush(stdout);
-
- /* after break we go back to saved settings */
- if (using_oldshell && !replace_intr) {
- SET_NONBLOCKING(1);
- }
- else if (saved) {
- tcsetattr(0,TCSANOW,&temp_mode);
- }
-
- erts_smp_thr_progress_unblock();
-}
-
-static pid_t
-getpid(void)
-{
- return get_bid(current_process());
-}
-
-int getpagesize(void)
-{
- return 1024;
-}
-
-
-/* Fills in the systems representation of the jam/beam process identifier.
-** The Pid is put in STRING representation in the supplied buffer,
-** no interpretatione of this should be done by the rest of the
-** emulator. The buffer should be at least 21 bytes long.
-*/
-void sys_get_pid(char *buffer, size_t buffer_size){
- pid_t p = getpid();
- /* Assume the pid is scalar and can rest in an unsigned long... */
- erts_snprintf(buffer, buffer_size, "%lu",(unsigned long) p);
-}
-
-int
-erts_sys_putenv_raw(char *key, char *value) {
- return erts_sys_putenv(key, value);
-}
-int
-erts_sys_putenv(char *key, char *value)
-{
- int res;
-
- erts_smp_rwmtx_rwlock(&environ_rwmtx);
- res = set_env(get_bid(current_process()), key,
- value);
- erts_smp_rwmtx_rwunlock(&environ_rwmtx);
- return res;
-}
-
-
-int
-erts_sys_unsetenv(char *key)
-{
- int res;
-
- erts_smp_rwmtx_rwlock(&environ_rwmtx);
- res = set_env(get_bid(current_process()),key,NULL);
- erts_smp_rwmtx_rwunlock(&environ_rwmtx);
-
- return res;
-}
-
-int
-erts_sys_getenv__(char *key, char *value, size_t *size)
-{
- int res;
- char *orig_value = get_env(get_bid(current_process()), key);
- if (!orig_value)
- res = -1;
- else {
- size_t len = sys_strlen(orig_value);
- if (len >= *size) {
- *size = len + 1;
- res = 1;
- }
- else {
- *size = len;
- sys_memcpy((void *) value, (void *) orig_value, len+1);
- res = 0;
- }
- free_buf((union SIGNAL **)&orig_value);
- }
- return res;
-}
-
-int
-erts_sys_getenv_raw(char *key, char *value, size_t *size) {
- return erts_sys_getenv(key, value, size);
-}
-
-/*
- * erts_sys_getenv
- * returns:
- * -1, if environment key is not set with a value
- * 0, if environment key is set and value fits into buffer res
- * 1, if environment key is set but does not fit into buffer res
- * res is set with the needed buffer res value
- */
-
-int
-erts_sys_getenv(char *key, char *value, size_t *size)
-{
- int res;
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- res = erts_sys_getenv__(key, value, size);
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- return res;
-}
-
-void
-sys_init_io(void)
-{
- fd_data = (struct fd_data *)
- erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data));
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
- max_files * sizeof(struct fd_data));
-}
-
-extern const char pre_loaded_code[];
-extern Preload pre_loaded[];
-
-void erts_sys_alloc_init(void)
-{
-}
-
-void *erts_sys_alloc(ErtsAlcType_t t, void *x, Uint sz)
-{
- void *res = malloc((size_t) sz);
-#if HAVE_ERTS_MSEG
- if (!res) {
- erts_mseg_clear_cache();
- return malloc((size_t) sz);
- }
-#endif
- return res;
-}
-
-void *erts_sys_realloc(ErtsAlcType_t t, void *x, void *p, Uint sz)
-{
- void *res = realloc(p, (size_t) sz);
-#if HAVE_ERTS_MSEG
- if (!res) {
- erts_mseg_clear_cache();
- return realloc(p, (size_t) sz);
- }
-#endif
- return res;
-}
-
-void erts_sys_free(ErtsAlcType_t t, void *x, void *p)
-{
- free(p);
-}
-
-/* Return a pointer to a vector of names of preloaded modules */
-
-Preload*
-sys_preloaded(void)
-{
- return pre_loaded;
-}
-
-/* Return a pointer to preloaded code for module "module" */
-unsigned char*
-sys_preload_begin(Preload* p)
-{
- return p->code;
-}
-
-/* Clean up if allocated */
-void sys_preload_end(Preload* p)
-{
- /* Nothing */
-}
-
-/* Read a key from console (?) */
-
-int sys_get_key(fd)
-int fd;
-{
- int c;
- unsigned char rbuf[64];
-
- fflush(stdout); /* Flush query ??? */
-
- if ((c = read(fd,rbuf,64)) <= 0) {
- return c;
- }
-
- return rbuf[0];
-}
-
-
-#ifdef DEBUG
-
-extern int erts_initialized;
-void
-erl_assert_error(const char* expr, const char* func,
- const char* file, int line)
-{
- fflush(stdout);
- fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n",
- file, line, func, expr);
- fflush(stderr);
- ramlog_printf("%s:%d:%s() Assertion failed: %s\n",
- file, line, func, expr);
-
- abort();
-}
-
-void
-erl_debug(char* fmt, ...)
-{
- char sbuf[1024]; /* Temporary buffer. */
- va_list va;
-
- if (debug_log) {
- va_start(va, fmt);
- vsprintf(sbuf, fmt, va);
- va_end(va);
- fprintf(stderr, "%s", sbuf);
- }
-}
-
-#endif /* DEBUG */
-
-static ERTS_INLINE void
-report_exit_status(ErtsSysReportExit *rep, int status)
-{
- if (rep->ifd >= 0) {
- driver_data[rep->ifd].alive = 0;
- driver_data[rep->ifd].status = status;
- }
- if (rep->ofd >= 0) {
- driver_data[rep->ofd].alive = 0;
- driver_data[rep->ofd].status = status;
- }
-
- erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep);
-}
-
-#define ERTS_REPORT_EXIT_STATUS report_exit_status
-
-/*
- * Called from schedule() when it runs out of runnable processes,
- * or when Erlang code has performed INPUT_REDUCTIONS reduction
- * steps. runnable == 0 iff there are no runnable Erlang processes.
- */
-void
-erl_sys_schedule(int runnable)
-{
- ASSERT(get_fsem(current_process()) == 0);
-#ifdef ERTS_SMP
- ASSERT(erts_get_scheduler_data()->no == 1);
- ERTS_CHK_IO(!runnable);
-#else
- ERTS_CHK_IO( 1 );
-#endif
- ASSERT(get_fsem(current_process()) == 0);
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
-}
-
-
-#ifdef ERTS_SMP
-
-void
-erts_sys_main_thread(void)
-{
- erts_thread_disable_fpe();
-
- /* Become signal receiver thread... */
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_set_thread_name("signal_receiver");
-#endif
-
- while (1) {
- static const SIGSELECT sigsel[] = {0};
- union SIGNAL *msg = receive(sigsel);
-
- fprintf(stderr,"Main thread got message %d from 0x%x!!\r\n",
- msg->sig_no, sender(&msg));
- free_buf(&msg);
- }
-}
-
-#endif /* ERTS_SMP */
-
-void
-erl_sys_args(int* argc, char** argv)
-{
- int i, j;
-
- erts_smp_rwmtx_init(&environ_rwmtx, "environ");
-
- init_check_io();
-
- /* Handled arguments have been marked with NULL. Slide arguments
- not handled towards the beginning of argv. */
- for (i = 0, j = 0; i < *argc; i++) {
- if (argv[i])
- argv[j++] = argv[i];
- }
- *argc = j;
-
-}
diff --git a/erts/emulator/sys/ose/sys_float.c b/erts/emulator/sys/ose/sys_float.c
deleted file mode 100644
index 3d9abc6bd1..0000000000
--- a/erts/emulator/sys/ose/sys_float.c
+++ /dev/null
@@ -1,845 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "global.h"
-#include "erl_process.h"
-
-
-#ifdef NO_FPE_SIGNALS
-
-void
-erts_sys_init_float(void)
-{
-# ifdef SIGFPE
- sys_sigset(SIGFPE, SIG_IGN); /* Ignore so we can test for NaN and Inf */
-# endif
-}
-
-#else /* !NO_FPE_SIGNALS */
-
-#ifdef ERTS_SMP
-static erts_tsd_key_t fpe_key;
-
-/* once-only initialisation early in the main thread (via erts_sys_init_float()) */
-static void erts_init_fp_exception(void)
-{
- /* XXX: the wrappers prevent using a pthread destructor to
- deallocate the key's value; so when/where do we do that? */
- erts_tsd_key_create(&fpe_key);
-}
-
-void erts_thread_init_fp_exception(void)
-{
- unsigned long *fpe = erts_alloc(ERTS_ALC_T_FP_EXCEPTION, sizeof(*fpe));
- *fpe = 0L;
- erts_tsd_set(fpe_key, fpe);
-}
-
-static ERTS_INLINE volatile unsigned long *erts_thread_get_fp_exception(void)
-{
- return (volatile unsigned long*)erts_tsd_get(fpe_key);
-}
-#else /* !SMP */
-#define erts_init_fp_exception() /*empty*/
-static volatile unsigned long fp_exception;
-#define erts_thread_get_fp_exception() (&fp_exception)
-#endif /* SMP */
-
-volatile unsigned long *erts_get_current_fp_exception(void)
-{
- Process *c_p;
-
- c_p = erts_get_current_process();
- if (c_p)
- return &c_p->fp_exception;
- return erts_thread_get_fp_exception();
-}
-
-static void set_current_fp_exception(unsigned long pc)
-{
- volatile unsigned long *fpexnp = erts_get_current_fp_exception();
- ASSERT(fpexnp != NULL);
- *fpexnp = pc;
-}
-
-void erts_fp_check_init_error(volatile unsigned long *fpexnp)
-{
- char buf[64];
- snprintf(buf, sizeof buf, "ERTS_FP_CHECK_INIT at %p: detected unhandled FPE at %p\r\n",
- __builtin_return_address(0), (void*)*fpexnp);
- if (write(2, buf, strlen(buf)) <= 0)
- erl_exit(ERTS_ABORT_EXIT, "%s", buf);
- *fpexnp = 0;
-#if defined(__i386__) || defined(__x86_64__)
- erts_restore_fpu();
-#endif
-}
-
-/* Is there no standard identifier for Darwin/MacOSX ? */
-#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
-#define __DARWIN__ 1
-#endif
-
-#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
-
-static void unmask_x87(void)
-{
- unsigned short cw;
-
- __asm__ __volatile__("fstcw %0" : "=m"(cw));
- cw &= ~(0x01|0x04|0x08); /* unmask IM, ZM, OM */
- __asm__ __volatile__("fldcw %0" : : "m"(cw));
-}
-
-/* mask x87 FPE, return true if the previous state was unmasked */
-static int mask_x87(void)
-{
- unsigned short cw;
- int unmasked;
-
- __asm__ __volatile__("fstcw %0" : "=m"(cw));
- unmasked = (cw & (0x01|0x04|0x08)) == 0;
- /* or just set cw = 0x37f */
- cw |= (0x01|0x04|0x08); /* mask IM, ZM, OM */
- __asm__ __volatile__("fldcw %0" : : "m"(cw));
- return unmasked;
-}
-
-static void unmask_sse2(void)
-{
- unsigned int mxcsr;
-
- __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr));
- mxcsr &= ~(0x003F|0x0680); /* clear exn flags, unmask OM, ZM, IM (not PM, UM, DM) */
- __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr));
-}
-
-/* mask SSE2 FPE, return true if the previous state was unmasked */
-static int mask_sse2(void)
-{
- unsigned int mxcsr;
- int unmasked;
-
- __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr));
- unmasked = (mxcsr & 0x0680) == 0;
- /* or just set mxcsr = 0x1f80 */
- mxcsr &= ~0x003F; /* clear exn flags */
- mxcsr |= 0x0680; /* mask OM, ZM, IM (not PM, UM, DM) */
- __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr));
- return unmasked;
-}
-
-#if defined(__x86_64__)
-
-static inline int cpu_has_sse2(void) { return 1; }
-
-#else /* !__x86_64__ */
-
-/*
- * Check if an x86-32 processor has SSE2.
- */
-static unsigned int xor_eflags(unsigned int mask)
-{
- unsigned int eax, edx;
-
- eax = mask; /* eax = mask */
- __asm__("pushfl\n\t"
- "popl %0\n\t" /* edx = original EFLAGS */
- "xorl %0, %1\n\t" /* eax = mask ^ EFLAGS */
- "pushl %1\n\t"
- "popfl\n\t" /* new EFLAGS = mask ^ original EFLAGS */
- "pushfl\n\t"
- "popl %1\n\t" /* eax = new EFLAGS */
- "xorl %0, %1\n\t" /* eax = new EFLAGS ^ old EFLAGS */
- "pushl %0\n\t"
- "popfl" /* restore original EFLAGS */
- : "=d"(edx), "=a"(eax)
- : "1"(eax));
- return eax;
-}
-
-static __inline__ unsigned int cpuid_eax(unsigned int op)
-{
- unsigned int eax, save_ebx;
-
- /* In PIC mode i386 reserves EBX. So we must save
- and restore it ourselves to not upset gcc. */
- __asm__(
- "movl %%ebx, %1\n\t"
- "cpuid\n\t"
- "movl %1, %%ebx"
- : "=a"(eax), "=m"(save_ebx)
- : "0"(op)
- : "cx", "dx");
- return eax;
-}
-
-static __inline__ unsigned int cpuid_edx(unsigned int op)
-{
- unsigned int eax, edx, save_ebx;
-
- /* In PIC mode i386 reserves EBX. So we must save
- and restore it ourselves to not upset gcc. */
- __asm__(
- "movl %%ebx, %2\n\t"
- "cpuid\n\t"
- "movl %2, %%ebx"
- : "=a"(eax), "=d"(edx), "=m"(save_ebx)
- : "0"(op)
- : "cx");
- return edx;
-}
-
-/* The AC bit, bit #18, is a new bit introduced in the EFLAGS
- * register on the Intel486 processor to generate alignment
- * faults. This bit cannot be set on the Intel386 processor.
- */
-static __inline__ int is_386(void)
-{
- return ((xor_eflags(1<<18) >> 18) & 1) == 0;
-}
-
-/* Newer x86 processors have a CPUID instruction, as indicated by
- * the ID bit (#21) in EFLAGS being modifiable.
- */
-static __inline__ int has_CPUID(void)
-{
- return (xor_eflags(1<<21) >> 21) & 1;
-}
-
-static int cpu_has_sse2(void)
-{
- unsigned int maxlev, features;
- static int has_sse2 = -1;
-
- if (has_sse2 >= 0)
- return has_sse2;
- has_sse2 = 0;
-
- if (is_386())
- return 0;
- if (!has_CPUID())
- return 0;
- maxlev = cpuid_eax(0);
- /* Intel A-step Pentium had a preliminary version of CPUID.
- It also didn't have SSE2. */
- if ((maxlev & 0xFFFFFF00) == 0x0500)
- return 0;
- /* If max level is zero then CPUID cannot report any features. */
- if (maxlev == 0)
- return 0;
- features = cpuid_edx(1);
- has_sse2 = (features & (1 << 26)) != 0;
-
- return has_sse2;
-}
-#endif /* !__x86_64__ */
-
-static void unmask_fpe(void)
-{
- __asm__ __volatile__("fnclex");
- unmask_x87();
- if (cpu_has_sse2())
- unmask_sse2();
-}
-
-static void unmask_fpe_conditional(int unmasked)
-{
- if (unmasked)
- unmask_fpe();
-}
-
-/* mask x86 FPE, return true if the previous state was unmasked */
-static int mask_fpe(void)
-{
- int unmasked;
-
- unmasked = mask_x87();
- if (cpu_has_sse2())
- unmasked |= mask_sse2();
- return unmasked;
-}
-
-void erts_restore_fpu(void)
-{
- __asm__ __volatile__("fninit");
- unmask_x87();
- if (cpu_has_sse2())
- unmask_sse2();
-}
-
-#elif defined(__sparc__) && defined(__linux__)
-
-#if defined(__arch64__)
-#define LDX "ldx"
-#define STX "stx"
-#else
-#define LDX "ld"
-#define STX "st"
-#endif
-
-static void unmask_fpe(void)
-{
- unsigned long fsr;
-
- __asm__(STX " %%fsr, %0" : "=m"(fsr));
- fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */
- fsr |= (0x1AUL << 23); /* enable NV, OF, DZ exceptions */
- __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr));
-}
-
-static void unmask_fpe_conditional(int unmasked)
-{
- if (unmasked)
- unmask_fpe();
-}
-
-/* mask SPARC FPE, return true if the previous state was unmasked */
-static int mask_fpe(void)
-{
- unsigned long fsr;
- int unmasked;
-
- __asm__(STX " %%fsr, %0" : "=m"(fsr));
- unmasked = ((fsr >> 23) & 0x1A) == 0x1A;
- fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */
- __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr));
- return unmasked;
-}
-
-#elif (defined(__powerpc__) && defined(__linux__)) || (defined(__ppc__) && defined(__DARWIN__))
-
-#if defined(__linux__)
-#include <sys/prctl.h>
-
-static void set_fpexc_precise(void)
-{
- if (prctl(PR_SET_FPEXC, PR_FP_EXC_PRECISE) < 0) {
- perror("PR_SET_FPEXC");
- exit(1);
- }
-}
-
-#elif defined(__DARWIN__)
-
-#include <mach/mach.h>
-#include <pthread.h>
-
-/*
- * FE0 FE1 MSR bits
- * 0 0 floating-point exceptions disabled
- * 0 1 floating-point imprecise nonrecoverable
- * 1 0 floating-point imprecise recoverable
- * 1 1 floating-point precise mode
- *
- * Apparently:
- * - Darwin 5.5 (MacOS X <= 10.1) starts with FE0 == FE1 == 0,
- * and resets FE0 and FE1 to 0 after each SIGFPE.
- * - Darwin 6.0 (MacOS X 10.2) starts with FE0 == FE1 == 1,
- * and does not reset FE0 or FE1 after a SIGFPE.
- */
-#define FE0_MASK (1<<11)
-#define FE1_MASK (1<<8)
-
-/* a thread cannot get or set its own MSR bits */
-static void *fpu_fpe_enable(void *arg)
-{
- thread_t t = *(thread_t*)arg;
- struct ppc_thread_state state;
- unsigned int state_size = PPC_THREAD_STATE_COUNT;
-
- if (thread_get_state(t, PPC_THREAD_STATE, (natural_t*)&state, &state_size) != KERN_SUCCESS) {
- perror("thread_get_state");
- exit(1);
- }
- if ((state.srr1 & (FE1_MASK|FE0_MASK)) != (FE1_MASK|FE0_MASK)) {
-#if 1
- /* This would also have to be performed in the SIGFPE handler
- to work around the MSR reset older Darwin releases do. */
- state.srr1 |= (FE1_MASK|FE0_MASK);
- thread_set_state(t, PPC_THREAD_STATE, (natural_t*)&state, state_size);
-#else
- fprintf(stderr, "srr1 == 0x%08x, your Darwin is too old\n", state.srr1);
- exit(1);
-#endif
- }
- return NULL; /* Ok, we appear to be on Darwin 6.0 or later */
-}
-
-static void set_fpexc_precise(void)
-{
- thread_t self = mach_thread_self();
- pthread_t enabler;
-
- if (pthread_create(&enabler, NULL, fpu_fpe_enable, &self)) {
- perror("pthread_create");
- } else if (pthread_join(enabler, NULL)) {
- perror("pthread_join");
- }
-}
-
-#endif
-
-static void set_fpscr(unsigned int fpscr)
-{
- union {
- double d;
- unsigned int fpscr[2];
- } u;
-
- u.fpscr[0] = 0xFFF80000;
- u.fpscr[1] = fpscr;
- __asm__ __volatile__("mtfsf 255,%0" : : "f"(u.d));
-}
-
-static unsigned int get_fpscr(void)
-{
- union {
- double d;
- unsigned int fpscr[2];
- } u;
-
- __asm__("mffs %0" : "=f"(u.d));
- return u.fpscr[1];
-}
-
-static void unmask_fpe(void)
-{
- set_fpexc_precise();
- set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */
-}
-
-static void unmask_fpe_conditional(int unmasked)
-{
- if (unmasked)
- unmask_fpe();
-}
-
-/* mask PowerPC FPE, return true if the previous state was unmasked */
-static int mask_fpe(void)
-{
- int unmasked;
-
- unmasked = (get_fpscr() & (0x80|0x40|0x10)) == (0x80|0x40|0x10);
- set_fpscr(0x00);
- return unmasked;
-}
-
-#else
-
-static void unmask_fpe(void)
-{
- fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ);
-}
-
-static void unmask_fpe_conditional(int unmasked)
-{
- if (unmasked)
- unmask_fpe();
-}
-
-/* mask IEEE FPE, return true if previous state was unmasked */
-static int mask_fpe(void)
-{
- const fp_except unmasked_mask = FP_X_INV | FP_X_OFL | FP_X_DZ;
- fp_except old_mask;
-
- old_mask = fpsetmask(0);
- return (old_mask & unmasked_mask) == unmasked_mask;
-}
-
-#endif
-
-#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || ((defined(__NetBSD__) || defined(__OpenBSD__)) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__))
-
-#if defined(__linux__) && defined(__i386__)
-#if !defined(X86_FXSR_MAGIC)
-#define X86_FXSR_MAGIC 0x0000
-#endif
-#elif defined(__FreeBSD__) && defined(__x86_64__)
-#include <sys/types.h>
-#include <machine/fpu.h>
-#elif defined(__FreeBSD__) && defined(__i386__)
-#include <sys/types.h>
-#include <machine/npx.h>
-#elif defined(__DARWIN__)
-#include <machine/signal.h>
-#elif defined(__OpenBSD__) && defined(__x86_64__)
-#include <sys/types.h>
-#include <machine/fpu.h>
-#endif
-#if !(defined(__OpenBSD__) && defined(__x86_64__))
-#include <ucontext.h>
-#endif
-#include <string.h>
-
-#if defined(__linux__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->gregs[REG_RIP])
-#elif defined(__linux__) && defined(__i386__)
-#define mc_pc(mc) ((mc)->gregs[REG_EIP])
-#elif defined(__DARWIN__) && defined(__i386__)
-#ifdef DARWIN_MODERN_MCONTEXT
-#define mc_pc(mc) ((mc)->__ss.__eip)
-#else
-#define mc_pc(mc) ((mc)->ss.eip)
-#endif
-#elif defined(__DARWIN__) && defined(__x86_64__)
-#ifdef DARWIN_MODERN_MCONTEXT
-#define mc_pc(mc) ((mc)->__ss.__rip)
-#else
-#define mc_pc(mc) ((mc)->ss.rip)
-#endif
-#elif defined(__FreeBSD__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->mc_rip)
-#elif defined(__FreeBSD__) && defined(__i386__)
-#define mc_pc(mc) ((mc)->mc_eip)
-#elif defined(__NetBSD__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->__gregs[_REG_RIP])
-#elif defined(__NetBSD__) && defined(__i386__)
-#define mc_pc(mc) ((mc)->__gregs[_REG_EIP])
-#elif defined(__OpenBSD__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->sc_rip)
-#elif defined(__sun__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->gregs[REG_RIP])
-#endif
-
-static void fpe_sig_action(int sig, siginfo_t *si, void *puc)
-{
- ucontext_t *uc = puc;
- unsigned long pc;
-
-#if defined(__linux__)
-#if defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- fpregset_t fpstate = mc->fpregs;
- pc = mc_pc(mc);
- /* A failed SSE2 instruction will restart. To avoid
- looping we mask SSE2 exceptions now and unmask them
- again later in erts_check_fpe()/erts_restore_fpu().
- On RISCs we update PC to skip the failed instruction,
- but the ever increasing complexity of the x86 instruction
- set encoding makes that a poor solution here. */
- fpstate->mxcsr = 0x1F80;
- fpstate->swd &= ~0xFF;
-#elif defined(__i386__)
- mcontext_t *mc = &uc->uc_mcontext;
- fpregset_t fpstate = mc->fpregs;
- pc = mc_pc(mc);
- if ((fpstate->status >> 16) == X86_FXSR_MAGIC)
- ((struct _fpstate*)fpstate)->mxcsr = 0x1F80;
- fpstate->sw &= ~0xFF;
-#elif defined(__sparc__) && defined(__arch64__)
- /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */
- struct sigcontext *sc = (struct sigcontext*)puc;
- pc = sc->sigc_regs.tpc;
- sc->sigc_regs.tpc = sc->sigc_regs.tnpc;
- sc->sigc_regs.tnpc += 4;
-#elif defined(__sparc__)
- /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */
- struct sigcontext *sc = (struct sigcontext*)puc;
- pc = sc->si_regs.pc;
- sc->si_regs.pc = sc->si_regs.npc;
- sc->si_regs.npc = (unsigned long)sc->si_regs.npc + 4;
-#elif defined(__powerpc__)
-#if defined(__powerpc64__)
- mcontext_t *mc = &uc->uc_mcontext;
- unsigned long *regs = &mc->gp_regs[0];
-#else
- mcontext_t *mc = uc->uc_mcontext.uc_regs;
- unsigned long *regs = &mc->gregs[0];
-#endif
- pc = regs[PT_NIP];
- regs[PT_NIP] += 4;
- regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */
-#endif
-#elif defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__))
-#ifdef DARWIN_MODERN_MCONTEXT
- mcontext_t mc = uc->uc_mcontext;
- pc = mc_pc(mc);
- mc->__fs.__fpu_mxcsr = 0x1F80;
- *(unsigned short *)&mc->__fs.__fpu_fsw &= ~0xFF;
-#else
- mcontext_t mc = uc->uc_mcontext;
- pc = mc_pc(mc);
- mc->fs.fpu_mxcsr = 0x1F80;
- *(unsigned short *)&mc->fs.fpu_fsw &= ~0xFF;
-#endif /* DARWIN_MODERN_MCONTEXT */
-#elif defined(__DARWIN__) && defined(__ppc__)
- mcontext_t mc = uc->uc_mcontext;
- pc = mc->ss.srr0;
- mc->ss.srr0 += 4;
- mc->fs.fpscr = 0x80|0x40|0x10;
-#elif defined(__FreeBSD__) && defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- struct savefpu *savefpu = (struct savefpu*)&mc->mc_fpstate;
- struct envxmm *envxmm = &savefpu->sv_env;
- pc = mc_pc(mc);
- envxmm->en_mxcsr = 0x1F80;
- envxmm->en_sw &= ~0xFF;
-#elif defined(__FreeBSD__) && defined(__i386__)
- mcontext_t *mc = &uc->uc_mcontext;
- union savefpu *savefpu = (union savefpu*)&mc->mc_fpstate;
- pc = mc_pc(mc);
- if (mc->mc_fpformat == _MC_FPFMT_XMM) {
- struct envxmm *envxmm = &savefpu->sv_xmm.sv_env;
- envxmm->en_mxcsr = 0x1F80;
- envxmm->en_sw &= ~0xFF;
- } else {
- struct env87 *env87 = &savefpu->sv_87.sv_env;
- env87->en_sw &= ~0xFF;
- }
-#elif defined(__NetBSD__) && defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- struct fxsave64 *fxsave = (struct fxsave64 *)&mc->__fpregs;
- pc = mc_pc(mc);
- fxsave->fx_mxcsr = 0x1F80;
- fxsave->fx_fsw &= ~0xFF;
-#elif defined(__NetBSD__) && defined(__i386__)
- mcontext_t *mc = &uc->uc_mcontext;
- pc = mc_pc(mc);
- if (uc->uc_flags & _UC_FXSAVE) {
- struct envxmm *envxmm = (struct envxmm *)&mc->__fpregs;
- envxmm->en_mxcsr = 0x1F80;
- envxmm->en_sw &= ~0xFF;
- } else {
- struct env87 *env87 = (struct env87 *)&mc->__fpregs;
- env87->en_sw &= ~0xFF;
- }
-#elif defined(__OpenBSD__) && defined(__x86_64__)
- struct fxsave64 *fxsave = uc->sc_fpstate;
- pc = mc_pc(uc);
- fxsave->fx_mxcsr = 0x1F80;
- fxsave->fx_fsw &= ~0xFF;
-#elif defined(__sun__) && defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- struct fpchip_state *fpstate = &mc->fpregs.fp_reg_set.fpchip_state;
- pc = mc_pc(mc);
- fpstate->mxcsr = 0x1F80;
- fpstate->sw &= ~0xFF;
-#endif
-#if 0
- {
- char buf[64];
- snprintf(buf, sizeof buf, "%s: FPE at %p\r\n", __FUNCTION__, (void*)pc);
- write(2, buf, strlen(buf));
- }
-#endif
- set_current_fp_exception(pc);
-}
-
-static void erts_thread_catch_fp_exceptions(void)
-{
- struct sigaction act;
- memset(&act, 0, sizeof act);
- act.sa_sigaction = fpe_sig_action;
- act.sa_flags = SA_SIGINFO;
- sigaction(SIGFPE, &act, NULL);
- unmask_fpe();
-}
-
-#else /* !((__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */
-
-static void fpe_sig_handler(int sig)
-{
- set_current_fp_exception(1); /* XXX: convert to sigaction so we can get the trap PC */
-}
-
-static void erts_thread_catch_fp_exceptions(void)
-{
- sys_sigset(SIGFPE, fpe_sig_handler);
- unmask_fpe();
-}
-
-#endif /* (__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */
-
-/* once-only initialisation early in the main thread */
-void erts_sys_init_float(void)
-{
- erts_init_fp_exception();
- erts_thread_catch_fp_exceptions();
- erts_printf_block_fpe = erts_sys_block_fpe;
- erts_printf_unblock_fpe = erts_sys_unblock_fpe;
-}
-
-#endif /* NO_FPE_SIGNALS */
-
-void erts_thread_init_float(void)
-{
-#ifdef ERTS_SMP
- /* This allows Erlang schedulers to leave Erlang-process context
- and still have working FP exceptions. XXX: is this needed? */
- erts_thread_init_fp_exception();
-#endif
-
-#ifndef NO_FPE_SIGNALS
- /* NOTE:
- * erts_thread_disable_fpe() is called in all threads at
- * creation. We at least need to call unmask_fpe()
- */
-#if defined(__DARWIN__) || defined(__FreeBSD__)
- /* Darwin (7.9.0) does not appear to propagate FP exception settings
- to a new thread from its parent. So if we want FP exceptions, we
- must manually re-enable them in each new thread.
- FreeBSD 6.1 appears to suffer from a similar issue. */
- erts_thread_catch_fp_exceptions();
-#else
- unmask_fpe();
-#endif
-
-#endif
-}
-
-void erts_thread_disable_fpe(void)
-{
-#if !defined(NO_FPE_SIGNALS)
- (void)mask_fpe();
-#endif
-}
-
-#if !defined(NO_FPE_SIGNALS)
-int erts_sys_block_fpe(void)
-{
- return mask_fpe();
-}
-
-void erts_sys_unblock_fpe(int unmasked)
-{
- unmask_fpe_conditional(unmasked);
-}
-#endif
-
-/* The following check is incorporated from the Vee machine */
-
-#define ISDIGIT(d) ((d) >= '0' && (d) <= '9')
-
-/*
- ** Convert a double to ascii format 0.dddde[+|-]ddd
- ** return number of characters converted or -1 if error.
- **
- ** These two functions should maybe use localeconv() to pick up
- ** the current radix character, but since it is uncertain how
- ** expensive such a system call is, and since no-one has heard
- ** of other radix characters than '.' and ',' an ad-hoc
- ** low execution time solution is used instead.
- */
-
-int
-sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t decimals)
-{
- char *s = buffer;
-
- if (erts_snprintf(buffer, buffer_size, "%.*e", decimals, fp) >= buffer_size)
- return -1;
- /* Search upto decimal point */
- if (*s == '+' || *s == '-') s++;
- while (ISDIGIT(*s)) s++;
- if (*s == ',') *s++ = '.'; /* Replace ',' with '.' */
- /* Scan to end of string */
- while (*s) s++;
- return s-buffer; /* i.e strlen(buffer) */
-}
-
-/* Float conversion */
-
-int
-sys_chars_to_double(char* buf, double* fp)
-{
-#ifndef NO_FPE_SIGNALS
- volatile unsigned long *fpexnp = erts_get_current_fp_exception();
-#endif
- char *s = buf, *t, *dp;
-
- /* Robert says that something like this is what he really wanted:
- * (The [.,] radix test is NOT what Robert wanted - it was added later)
- *
- * 7 == sscanf(Tbuf, "%[+-]%[0-9][.,]%[0-9]%[eE]%[+-]%[0-9]%s", ....);
- * if (*s2 == 0 || *s3 == 0 || *s4 == 0 || *s6 == 0 || *s7)
- * break;
- */
-
- /* Scan string to check syntax. */
- if (*s == '+' || *s == '-') s++;
- if (!ISDIGIT(*s)) /* Leading digits. */
- return -1;
- while (ISDIGIT(*s)) s++;
- if (*s != '.' && *s != ',') /* Decimal part. */
- return -1;
- dp = s++; /* Remember decimal point pos just in case */
- if (!ISDIGIT(*s))
- return -1;
- while (ISDIGIT(*s)) s++;
- if (*s == 'e' || *s == 'E') {
- /* There is an exponent. */
- s++;
- if (*s == '+' || *s == '-') s++;
- if (!ISDIGIT(*s))
- return -1;
- while (ISDIGIT(*s)) s++;
- }
- if (*s) /* That should be it */
- return -1;
-
-#ifdef NO_FPE_SIGNALS
- errno = 0;
-#endif
- __ERTS_FP_CHECK_INIT(fpexnp);
- *fp = strtod(buf, &t);
- __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1);
- if (t != s) { /* Whole string not scanned */
- /* Try again with other radix char */
- *dp = (*dp == '.') ? ',' : '.';
- errno = 0;
- __ERTS_FP_CHECK_INIT(fpexnp);
- *fp = strtod(buf, &t);
- __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1);
- }
-
-#ifdef NO_FPE_SIGNALS
- if (errno == ERANGE) {
- if (*fp == HUGE_VAL || *fp == -HUGE_VAL) {
- /* overflow, should give error */
- return -1;
- } else if (t == s && *fp == 0.0) {
- /* This should give 0.0 - OTP-7178 */
- errno = 0;
-
- } else if (*fp == 0.0) {
- return -1;
- }
- }
-#endif
- return 0;
-}
-
-int
-matherr(struct exception *exc)
-{
-#if !defined(NO_FPE_SIGNALS)
- volatile unsigned long *fpexnp = erts_get_current_fp_exception();
- if (fpexnp != NULL)
- *fpexnp = (unsigned long)__builtin_return_address(0);
-#endif
- return 1;
-}
diff --git a/erts/emulator/sys/ose/sys_time.c b/erts/emulator/sys/ose/sys_time.c
deleted file mode 100644
index 5dac75956a..0000000000
--- a/erts/emulator/sys/ose/sys_time.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2005-2009. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "global.h"
-
-/******************* Routines for time measurement *********************/
-
-int erts_ticks_per_sec = 0; /* Will be SYS_CLK_TCK in erl_unix_sys.h */
-
-int sys_init_time(void)
-{
- return SYS_CLOCK_RESOLUTION;
-}
-
-clock_t sys_times(SysTimes *now) {
- now->tms_utime = now->tms_stime = now->tms_cutime = now->tms_cstime = 0;
- return 0;
-}
-
-static OSTICK last_tick_count = 0;
-static SysHrTime wrap = 0;
-static OSTICK us_per_tick;
-
-void sys_init_hrtime() {
- us_per_tick = system_tick();
-}
-
-SysHrTime sys_gethrtime() {
- OSTICK ticks = get_ticks();
- if (ticks < (SysHrTime) last_tick_count) {
- wrap += 1ULL << 32;
- }
- last_tick_count = ticks;
- return ((((SysHrTime) ticks) + wrap) * 1000*us_per_tick);
-}
diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c
index a3c5c20641..4e61530cf1 100644
--- a/erts/emulator/sys/unix/erl_child_setup.c
+++ b/erts/emulator/sys/unix/erl_child_setup.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2015. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -19,109 +19,233 @@
*/
/*
- * After a vfork() (or fork()) the child exec()s to this program which
- * sets up the child and exec()s to the user program (see spawn_start()
- * in sys.c and ticket OTP-4389).
+ * This program is started at erts startup and all fork's that
+ * have to be done are done in here. This is done for a couple
+ * of reasons:
+ * - Allow usage of fork without a memory explosion.
+ * -- we do not want to use vfork, as it blocks the VM
+ * until the execv is done, and if the program that
+ * is to be executed is on an NFS that is unavailable,
+ * the execv can block for a very long time.
+ * -- we cannot do fork inside the VM as that would temporarily
+ * duplicate the memory usage of the VM per parallel exec.
+ *
+ * Some implementation notes:
+ * - A single Unix Domain Socket is setup in between the VM and
+ * this program. Over that UDS the file descriptors that should
+ * be used to talk to the child program are sent.
+ * The actual command to execute, together with options and the
+ * environment, is sent over the pipe represented by the
+ * file descriptors mentioned above. We don't send the
+ * command over the UDS as that would increase the likely hood
+ * that it's buffer would be full.
+ *
+ * - Since it is this program that execv's, it has to take care of
+ * all the SIGCHLD signals that the child programs generate. The
+ * signals are received and the pid+exit reason is sent as data
+ * on the UDS to the VM. The VM is then able to map the pid to the
+ * port of the child program that just exited and deliver the status
+ * code if requested.
*/
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
-#define NEED_CHILD_SETUP_DEFINES
-#include "sys.h"
-#include "erl_misc_utils.h"
+#include <stdlib.h>
+#include <stdio.h>
+#include <sys/wait.h>
-#ifdef SIG_SIGSET /* Old SysV */
-void sys_sigrelease(int sig)
+#define WANT_NONBLOCKING
+
+#include "erl_driver.h"
+#include "sys_uds.h"
+#include "hash.h"
+#include "erl_child_setup.h"
+
+#define SET_CLOEXEC(fd) fcntl(fd, F_SETFD, fcntl(fd, F_GETFD) | FD_CLOEXEC)
+
+#if defined(__ANDROID__)
+#define SHELL "/system/bin/sh"
+#else
+#define SHELL "/bin/sh"
+#endif /* __ANDROID__ */
+
+//#define HARD_DEBUG
+#ifdef HARD_DEBUG
+#define DEBUG_PRINT(fmt, ...) fprintf(stderr, fmt "\r\n", ##__VA_ARGS__)
+#else
+#define DEBUG_PRINT(fmt, ...)
+#endif
+
+#define ABORT(fmt, ...) do { \
+ fprintf(stderr, "erl_child_setup: " fmt "\r\n", ##__VA_ARGS__); \
+ abort(); \
+ } while(0)
+
+#ifdef DEBUG
+void
+erl_assert_error(const char* expr, const char* func, const char* file, int line)
{
- sigrelse(sig);
+ fflush(stdout);
+ fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n",
+ file, line, func, expr);
+ fflush(stderr);
+ abort();
}
-#else /* !SIG_SIGSET */
-#ifdef SIG_SIGNAL /* Old BSD */
-sys_sigrelease(int sig)
+#endif
+
+void sys_sigblock(int sig)
{
- sigsetmask(sigblock(0) & ~sigmask(sig));
+ sigset_t mask;
+
+ sigemptyset(&mask);
+ sigaddset(&mask, sig);
+ sigprocmask(SIG_BLOCK, &mask, (sigset_t *)NULL);
}
-#else /* !SIG_SIGNAL */ /* The True Way - POSIX!:-) */
+
void sys_sigrelease(int sig)
{
sigset_t mask;
-
sigemptyset(&mask);
sigaddset(&mask, sig);
sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL);
}
-#endif /* !SIG_SIGNAL */
-#endif /* !SIG_SIGSET */
-
-#if defined(__ANDROID__)
-static int system_properties_fd(void);
-#endif /* __ANDROID__ */
-#if defined(__ANDROID__)
-#define SHELL "/system/bin/sh"
-#else
-#define SHELL "/bin/sh"
-#endif /* __ANDROID__ */
+static void add_os_pid_to_port_id_mapping(Eterm, pid_t);
+static Eterm get_port_id(pid_t);
+static int forker_hash_init(void);
+static int max_files = -1;
+static int sigchld_pipe[2];
-int
-main(int argc, char *argv[])
+static int
+start_new_child(int pipes[])
{
- int i, from, to;
- int erts_spawn_executable = 0;
+ int size, res, i, pos = 0;
+ char *buff, *o_buff;
+
+ char *cmd, *wd, **new_environ, **args = NULL;
+
+ Sint cnt, flags;
- /* OBSERVE!
- * Keep child setup after fork() (implemented in sys.c) up to date
- * if changes are made here.
- */
+ /* only child executes here */
- if (argc != CS_ARGV_NO_OF_ARGS) {
- if (argc < CS_ARGV_NO_OF_ARGS) {
- return 1;
- } else {
- erts_spawn_executable = 1;
- }
+ do {
+ res = read(pipes[0], (char*)&size, sizeof(size));
+ } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK));
+
+ if (res <= 0) {
+ goto child_error;
}
- if (strcmp("false", argv[CS_ARGV_UNBIND_IX]) != 0)
- if (erts_unbind_from_cpu_str(argv[CS_ARGV_UNBIND_IX]) != 0)
- return 1;
+ buff = malloc(size);
+
+ DEBUG_PRINT("size = %d", size);
+
+ do {
+ if ((res = read(pipes[0], buff + pos, size - pos)) < 0) {
+ if (errno == ERRNO_BLOCK || errno == EINTR)
+ continue;
+ goto child_error;
+ }
+ if (res == 0) {
+ errno = EPIPE;
+ goto child_error;
+ }
+ pos += res;
+ } while(size - pos != 0);
+
+ o_buff = buff;
+
+ flags = get_int32(buff);
+ buff += sizeof(Sint32);
- for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) {
- if (argv[CS_ARGV_DUP2_OP_IX(i)][0] == '-'
- && argv[CS_ARGV_DUP2_OP_IX(i)][1] == '\0')
- break;
- if (sscanf(argv[CS_ARGV_DUP2_OP_IX(i)], "%d:%d", &from, &to) != 2)
- return 1;
- if (dup2(from, to) < 0)
- return 1;
+ DEBUG_PRINT("flags = %d", flags);
+
+ cmd = buff;
+ buff += strlen(buff) + 1;
+ if (*buff == '\0') {
+ wd = NULL;
+ } else {
+ wd = buff;
+ buff += strlen(buff) + 1;
}
+ buff++;
- if (sscanf(argv[CS_ARGV_FD_CR_IX], "%d:%d", &from, &to) != 2)
- return 1;
+ DEBUG_PRINT("wd = %s", wd);
-#if defined(HAVE_CLOSEFROM)
- closefrom(from);
-#elif defined(__ANDROID__)
- if (from <= to) {
- int spfd = system_properties_fd();
- for (i = from; i <= to; i++) {
- if (i != spfd) {
- (void) close(i);
- }
- }
+ cnt = get_int32(buff);
+ buff += sizeof(Sint32);
+ new_environ = malloc(sizeof(char*)*(cnt + 1));
+
+ DEBUG_PRINT("env_len = %ld", cnt);
+ for (i = 0; i < cnt; i++, buff++) {
+ new_environ[i] = buff;
+ while(*buff != '\0') buff++;
}
-#else /* !__ANDROID__ */
- for (i = from; i <= to; i++) {
- (void) close(i);
+ new_environ[cnt] = NULL;
+
+ if (o_buff + size != buff) {
+ /* This is a spawn executable call */
+ cnt = get_int32(buff);
+ buff += sizeof(Sint32);
+ args = malloc(sizeof(char*)*(cnt + 1));
+ for (i = 0; i < cnt; i++, buff++) {
+ args[i] = buff;
+ while(*buff != '\0') buff++;
+ }
+ args[cnt] = NULL;
}
-#endif /* HAVE_CLOSEFROM */
- if (!(argv[CS_ARGV_WD_IX][0] == '.' && argv[CS_ARGV_WD_IX][1] == '\0')
- && chdir(argv[CS_ARGV_WD_IX]) < 0)
- return 1;
+ if (o_buff + size != buff) {
+ errno = EINVAL;
+ goto child_error;
+ }
+
+ DEBUG_PRINT("read ack");
+ do {
+ ErtsSysForkerProto proto;
+ res = read(pipes[0], &proto, sizeof(proto));
+ if (res > 0) {
+ ASSERT(proto.action == ErtsSysForkerProtoAction_Ack);
+ ASSERT(res == sizeof(proto));
+ }
+ } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK));
+ if (res < 1) {
+ errno = EPIPE;
+ goto child_error;
+ }
+
+ DEBUG_PRINT("Do that forking business: '%s'\n",cmd);
+
+ /* When the dup2'ing below is done, only
+ fd's 0, 1, 2 and maybe 3, 4 should survive the
+ exec. All other fds (i.e. the unix domain sockets
+ and stray pipe ends) should have CLOEXEC set on them
+ so they will be closed when the exec happens */
+ if (flags & FORKER_FLAG_USE_STDIO) {
+ /* stdin for process */
+ if (flags & FORKER_FLAG_DO_WRITE &&
+ dup2(pipes[0], 0) < 0)
+ goto child_error;
+ /* stdout for process */
+ if (flags & FORKER_FLAG_DO_READ &&
+ dup2(pipes[1], 1) < 0)
+ goto child_error;
+ }
+ else { /* XXX will fail if pipes[0] == 4 (unlikely..) */
+ if (flags & FORKER_FLAG_DO_READ && dup2(pipes[1], 4) < 0)
+ goto child_error;
+ if (flags & FORKER_FLAG_DO_WRITE && dup2(pipes[0], 3) < 0)
+ goto child_error;
+ }
+
+ if (dup2(pipes[2], 2) < 0)
+ goto child_error;
+
+ if (wd && chdir(wd) < 0)
+ goto child_error;
#if defined(USE_SETPGRP_NOARGS) /* SysV */
(void) setpgrp();
@@ -131,34 +255,301 @@ main(int argc, char *argv[])
(void) setsid();
#endif
+ close(pipes[0]);
+ close(pipes[1]);
+ close(pipes[2]);
+
sys_sigrelease(SIGCHLD);
- sys_sigrelease(SIGINT);
- sys_sigrelease(SIGUSR1);
-
- if (erts_spawn_executable) {
- if (argv[CS_ARGV_NO_OF_ARGS + 1] == NULL) {
- execl(argv[CS_ARGV_NO_OF_ARGS],argv[CS_ARGV_NO_OF_ARGS],
- (char *) NULL);
- } else {
- execv(argv[CS_ARGV_NO_OF_ARGS],&(argv[CS_ARGV_NO_OF_ARGS + 1]));
- }
+
+ if (args) {
+ /* spawn_executable */
+ execve(cmd, args, new_environ);
} else {
- execl(SHELL, "sh", "-c", argv[CS_ARGV_CMD_IX], (char *) NULL);
+ execle(SHELL, "sh", "-c", cmd, (char *) NULL, new_environ);
}
- return 1;
+child_error:
+ DEBUG_PRINT("exec error: %d\r\n",errno);
+ _exit(128 + errno);
+}
+
+
+/*
+ * [OTP-3906]
+ * Solaris signal management gets confused when threads are used and a
+ * lot of child processes dies. The confusion results in that SIGCHLD
+ * signals aren't delivered to the emulator which in turn results in
+ * a lot of defunct processes in the system.
+ *
+ * The problem seems to appear when a signal is frequently
+ * blocked/unblocked at the same time as the signal is frequently
+ * propagated. The child waiter thread is a workaround for this problem.
+ * The SIGCHLD signal is always blocked (in all threads), and the child
+ * waiter thread fetches the signal by a call to sigwait(). See
+ * child_waiter().
+ *
+ * This should be a non-issue since the fork:ing was moved outside of
+ * the emulator into erl_child_setup. I'm leaving the comment here
+ * for posterity. */
+
+static void handle_sigchld(int sig) {
+ int buff[2], res;
+
+ sys_sigblock(SIGCHLD);
+
+ while ((buff[0] = waitpid((pid_t)(-1), buff+1, WNOHANG)) > 0) {
+ do {
+ res = write(sigchld_pipe[1], buff, sizeof(buff));
+ } while (res < 0 && errno == EINTR);
+ if (res <= 0)
+ ABORT("Failed to write to sigchld_pipe (%d): %d (%d)", sigchld_pipe[1], res, errno);
+ DEBUG_PRINT("Reap child %d (%d)", buff[0], buff[1]);
+ }
+
+ sys_sigrelease(SIGCHLD);
}
#if defined(__ANDROID__)
static int system_properties_fd(void)
{
- int fd;
+ static int fd = -2;
char *env;
+ if (fd != -2) return fd;
env = getenv("ANDROID_PROPERTY_WORKSPACE");
if (!env) {
+ fd = -1;
return -1;
}
fd = atoi(env);
return fd;
}
#endif /* __ANDROID__ */
+
+int
+main(int argc, char *argv[])
+{
+ /* This fd should be open from beam */
+ int uds_fd = 3, max_fd = 3;
+#ifndef HAVE_CLOSEFROM
+ int i;
+#endif
+ struct sigaction sa;
+
+ if (argc < 1 || sscanf(argv[1],"%d",&max_files) != 1) {
+ ABORT("Invalid arguments to child_setup");
+ }
+
+/* We close all fds except the uds from beam.
+ All other fds from now on will have the
+ CLOEXEC flags set on them. This means that we
+ only have to close a very limited number of fds
+ after we fork before the exec. */
+#if defined(HAVE_CLOSEFROM)
+ closefrom(4);
+#else
+ for (i = 4; i < max_files; i++)
+#if defined(__ANDROID__)
+ if (i != system_properties_fd())
+#endif
+ (void) close(i);
+#endif
+
+ if (pipe(sigchld_pipe) < 0) {
+ ABORT("Failed to setup sigchld pipe (%d)", errno);
+ }
+
+ SET_CLOEXEC(sigchld_pipe[0]);
+ SET_CLOEXEC(sigchld_pipe[1]);
+
+ max_fd = max_fd < sigchld_pipe[0] ? sigchld_pipe[0] : max_fd;
+
+ sa.sa_handler = &handle_sigchld;
+ sigemptyset(&sa.sa_mask);
+ sa.sa_flags = SA_RESTART | SA_NOCLDSTOP;
+ if (sigaction(SIGCHLD, &sa, 0) == -1) {
+ perror(0);
+ exit(1);
+ }
+
+ forker_hash_init();
+
+ SET_CLOEXEC(uds_fd);
+
+ DEBUG_PRINT("Starting forker %d", max_files);
+
+ while (1) {
+ fd_set read_fds;
+ int res;
+ FD_ZERO(&read_fds);
+ FD_SET(uds_fd, &read_fds);
+ FD_SET(sigchld_pipe[0], &read_fds);
+ DEBUG_PRINT("child_setup selecting on %d, %d (%d)",
+ uds_fd, sigchld_pipe[0], max_fd);
+ res = select(max_fd+1, &read_fds, NULL, NULL, NULL);
+
+ if (res < 0) {
+ if (errno == EINTR) continue;
+ ABORT("Select failed: %d (%d)",res, errno);
+ }
+
+ if (FD_ISSET(uds_fd, &read_fds)) {
+ int pipes[3], res, os_pid;
+ ErtsSysForkerProto proto;
+ errno = 0;
+ if ((res = sys_uds_read(uds_fd, (char*)&proto, sizeof(proto),
+ pipes, 3, MSG_DONTWAIT)) < 0) {
+ if (errno == EINTR)
+ continue;
+ DEBUG_PRINT("erl_child_setup failed to read from uds: %d, %d", res, errno);
+ _exit(0);
+ }
+
+ if (res == 0) {
+ DEBUG_PRINT("uds was closed!");
+ _exit(0);
+ }
+ /* Since we use unix domain sockets and send the entire data in
+ one go we *should* get the entire payload at once. */
+ ASSERT(res == sizeof(proto));
+ ASSERT(proto.action == ErtsSysForkerProtoAction_Start);
+
+ sys_sigblock(SIGCHLD);
+
+ errno = 0;
+
+ os_pid = fork();
+ if (os_pid == 0)
+ start_new_child(pipes);
+
+ add_os_pid_to_port_id_mapping(proto.u.start.port_id, os_pid);
+
+ /* We write an ack here, but expect the reply on
+ the pipes[0] inside the fork */
+ proto.action = ErtsSysForkerProtoAction_Go;
+ proto.u.go.os_pid = os_pid;
+ proto.u.go.error_number = errno;
+ while (write(pipes[1], &proto, sizeof(proto)) < 0 && errno == EINTR)
+ ; /* remove gcc warning */
+
+#ifdef FORKER_PROTO_START_ACK
+ proto.action = ErtsSysForkerProtoAction_StartAck;
+ while (write(uds_fd, &proto, sizeof(proto)) < 0 && errno == EINTR)
+ ; /* remove gcc warning */
+#endif
+
+ sys_sigrelease(SIGCHLD);
+ close(pipes[0]);
+ close(pipes[1]);
+ close(pipes[2]);
+ }
+
+ if (FD_ISSET(sigchld_pipe[0], &read_fds)) {
+ int ibuff[2];
+ ErtsSysForkerProto proto;
+ res = read(sigchld_pipe[0], ibuff, sizeof(ibuff));
+ if (res <= 0) {
+ if (errno == EINTR)
+ continue;
+ ABORT("Failed to read from sigchld pipe: %d (%d)", res, errno);
+ }
+
+ proto.u.sigchld.port_id = get_port_id((pid_t)(ibuff[0]));
+
+ if (proto.u.sigchld.port_id == THE_NON_VALUE)
+ continue; /* exit status report not requested */
+
+ proto.action = ErtsSysForkerProtoAction_SigChld;
+ proto.u.sigchld.error_number = ibuff[1];
+ DEBUG_PRINT("send %s to %d", buff, uds_fd);
+ if (write(uds_fd, &proto, sizeof(proto)) < 0) {
+ if (errno == EINTR)
+ continue;
+ /* The uds was close, which most likely means that the VM
+ has exited. This will be detected when we try to read
+ from the uds_fd. */
+ DEBUG_PRINT("Failed to write to uds: %d (%d)", uds_fd, errno);
+ }
+ }
+ }
+ return 1;
+}
+
+typedef struct exit_status {
+ HashBucket hb;
+ pid_t os_pid;
+ Eterm port_id;
+} ErtsSysExitStatus;
+
+static Hash *forker_hash;
+
+static void add_os_pid_to_port_id_mapping(Eterm port_id, pid_t os_pid)
+{
+ if (port_id != THE_NON_VALUE) {
+ /* exit status report requested */
+ ErtsSysExitStatus es;
+ es.os_pid = os_pid;
+ es.port_id = port_id;
+ hash_put(forker_hash, &es);
+ }
+}
+
+static Eterm get_port_id(pid_t os_pid)
+{
+ ErtsSysExitStatus est, *es;
+ Eterm port_id;
+ est.os_pid = os_pid;
+ es = hash_remove(forker_hash, &est);
+ if (!es) return THE_NON_VALUE;
+ port_id = es->port_id;
+ free(es);
+ return port_id;
+}
+
+static int fcmp(void *a, void *b)
+{
+ ErtsSysExitStatus *sa = a;
+ ErtsSysExitStatus *sb = b;
+ return !(sa->os_pid == sb->os_pid);
+}
+
+static HashValue fhash(void *e)
+{
+ ErtsSysExitStatus *se = e;
+ Uint32 val = se->os_pid;
+ val = (val+0x7ed55d16) + (val<<12);
+ val = (val^0xc761c23c) ^ (val>>19);
+ val = (val+0x165667b1) + (val<<5);
+ val = (val+0xd3a2646c) ^ (val<<9);
+ val = (val+0xfd7046c5) + (val<<3);
+ val = (val^0xb55a4f09) ^ (val>>16);
+ return val;
+}
+
+static void *falloc(void *e)
+{
+ ErtsSysExitStatus *se = e;
+ ErtsSysExitStatus *ne = malloc(sizeof(ErtsSysExitStatus));
+ ne->os_pid = se->os_pid;
+ ne->port_id = se->port_id;
+ return ne;
+}
+
+static void *meta_alloc(int type, size_t size) { return malloc(size); }
+static void meta_free(int type, void *p) { free(p); }
+
+static int forker_hash_init(void)
+{
+ HashFunctions forker_hash_functions;
+ forker_hash_functions.hash = fhash;
+ forker_hash_functions.cmp = fcmp;
+ forker_hash_functions.alloc = falloc;
+ forker_hash_functions.free = free;
+ forker_hash_functions.meta_alloc = meta_alloc;
+ forker_hash_functions.meta_free = meta_free;
+ forker_hash_functions.meta_print = NULL;
+
+ forker_hash = hash_new(0, "forker_hash",
+ 16, forker_hash_functions);
+
+ return 1;
+}
diff --git a/erts/emulator/sys/unix/erl_child_setup.h b/erts/emulator/sys/unix/erl_child_setup.h
new file mode 100644
index 0000000000..a28b136bfc
--- /dev/null
+++ b/erts/emulator/sys/unix/erl_child_setup.h
@@ -0,0 +1,77 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2015-2015. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * This file defines the interface inbetween erts and child_setup.
+ */
+
+#ifndef _ERL_UNIX_FORKER_H
+#define _ERL_UNIX_FORKER_H
+
+#include "sys.h"
+
+#ifdef __FreeBSD__
+/* The freebsd sendmsg man page explicitly states that
+ you should not close fds before they are known
+ to have reached the other side, so this Ack protects
+ against that. */
+#define FORKER_PROTO_START_ACK 1
+#endif
+
+#define FORKER_ARGV_NO_OF_ARGS 3
+#define FORKER_ARGV_PROGNAME_IX 0 /* Program name */
+#define FORKER_ARGV_MAX_FILES 1 /* max_files */
+
+#define FORKER_FLAG_USE_STDIO (1 << 0) /* dup the pipe to stdin/stderr */
+#define FORKER_FLAG_EXIT_STATUS (1 << 1) /* send the exit status to parent */
+#define FORKER_FLAG_DO_READ (1 << 2) /* dup write fd */
+#define FORKER_FLAG_DO_WRITE (1 << 3) /* dup read fd */
+
+#if SIZEOF_VOID_P == SIZEOF_LONG
+typedef unsigned long ErtsSysPortId;
+#elif SIZEOF_VOID_P == SIZEOF_INT
+typedef unsigned int ErtsSysPortId;
+#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG
+typedef unsigned long long ErtsSysPortId;
+#endif
+
+typedef struct ErtsSysForkerProto_ {
+ enum {
+ ErtsSysForkerProtoAction_Start,
+ ErtsSysForkerProtoAction_StartAck,
+ ErtsSysForkerProtoAction_Go,
+ ErtsSysForkerProtoAction_SigChld,
+ ErtsSysForkerProtoAction_Ack
+ } action;
+ union {
+ struct {
+ ErtsSysPortId port_id;
+ int fds[3];
+ } start;
+ struct {
+ pid_t os_pid;
+ int error_number;
+ } go;
+ struct {
+ ErtsSysPortId port_id;
+ int error_number;
+ } sigchld;
+ } u;
+} ErtsSysForkerProto;
+
+#endif /* #ifndef _ERL_UNIX_FORKER_H */
diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h
index 8d4e98bf3a..8b1822ca9f 100644
--- a/erts/emulator/sys/unix/erl_unix_sys.h
+++ b/erts/emulator/sys/unix/erl_unix_sys.h
@@ -30,9 +30,7 @@
#include <limits.h>
#include <stdlib.h>
#include <string.h>
-#ifndef QNX
#include <memory.h>
-#endif
#if defined(__sun__) && defined(__SVR4) && !defined(__EXTENSIONS__)
# define __EXTENSIONS__
@@ -92,11 +90,6 @@
#include <ieeefp.h>
#endif
-#ifdef QNX
-#include <process.h>
-#include <sys/qnx_glob.h>
-#endif
-
#include <pwd.h>
#ifndef HZ
@@ -108,6 +101,10 @@
#endif
#include <netdb.h>
+#ifdef HAVE_MACH_ABSOLUTE_TIME
+#include <mach/mach_time.h>
+#endif
+
#ifdef HAVE_POSIX_MEMALIGN
# define ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC 1
#endif
@@ -136,13 +133,6 @@
# define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
#endif
-#ifndef ENABLE_CHILD_WAITER_THREAD
-# ifdef ERTS_SMP
-# define ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
-void erts_check_children(void);
-# endif
-#endif
-
typedef void *GETENV_STATE;
/*
@@ -171,6 +161,7 @@ typedef long long ErtsSysHrTime;
#endif
typedef ErtsMonotonicTime ErtsSystemTime;
+typedef ErtsSysHrTime ErtsSysPerfCounter;
#define ERTS_MONOTONIC_TIME_MIN (((ErtsMonotonicTime) 1) << 63)
#define ERTS_MONOTONIC_TIME_MAX (~ERTS_MONOTONIC_TIME_MIN)
@@ -219,6 +210,7 @@ ErtsSystemTime erts_os_system_time(void);
* It may or may not be monotonic.
*/
ErtsSysHrTime erts_sys_hrtime(void);
+#define ERTS_HRTIME_UNIT (1000*1000*1000)
struct erts_sys_time_read_only_data__ {
#ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__
@@ -227,6 +219,8 @@ struct erts_sys_time_read_only_data__ {
#ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__
void (*os_times)(ErtsMonotonicTime *, ErtsSystemTime *);
#endif
+ ErtsSysPerfCounter (*perf_counter)(void);
+ ErtsSysPerfCounter perf_counter_unit;
int ticks_per_sec;
};
@@ -280,7 +274,24 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
#endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */
/*
- *
+ * Functions for getting the performance counter
+ */
+
+ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void);
+#define erts_sys_perf_counter_unit() erts_sys_time_data__.r.o.perf_counter_unit
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE ErtsSysPerfCounter
+erts_sys_perf_counter()
+{
+ return (*erts_sys_time_data__.r.o.perf_counter)();
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+/*
+ * Functions for measuring CPU time
*/
#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME))
@@ -310,7 +321,6 @@ typedef void (*SIGFUNC)(int);
extern SIGFUNC sys_signal(int, SIGFUNC);
extern void sys_sigrelease(int);
extern void sys_sigblock(int);
-extern void sys_stop_cat(void);
/*
* Handling of floating point exceptions.
@@ -425,19 +435,6 @@ void erts_sys_unblock_fpe(int);
#define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A)
-#ifdef NEED_CHILD_SETUP_DEFINES
-/* The child setup argv[] */
-#define CS_ARGV_PROGNAME_IX 0 /* Program name */
-#define CS_ARGV_UNBIND_IX 1 /* Unbind from cpu */
-#define CS_ARGV_WD_IX 2 /* Working directory */
-#define CS_ARGV_CMD_IX 3 /* Command */
-#define CS_ARGV_FD_CR_IX 4 /* Fd close range */
-#define CS_ARGV_DUP2_OP_IX(N) ((N) + 5) /* dup2 operations */
-
-#define CS_ARGV_NO_OF_DUP2_OPS 3 /* Number of dup2 ops */
-#define CS_ARGV_NO_OF_ARGS 8 /* Number of arguments */
-#endif /* #ifdef NEED_CHILD_SETUP_DEFINES */
-
/* Threads */
#ifdef USE_THREADS
extern int init_async(int);
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index 8d7da3e47e..2ad5f3b4d5 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -49,7 +49,6 @@
#include <sys/ioctl.h>
#endif
-#define NEED_CHILD_SETUP_DEFINES
#define ERTS_WANT_BREAK_HANDLING
#define ERTS_WANT_GOT_SIGUSR1
#define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */
@@ -67,7 +66,7 @@
#include "erl_mseg.h"
extern char **environ;
-static erts_smp_rwmtx_t environ_rwmtx;
+erts_smp_rwmtx_t environ_rwmtx;
#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O
* vector sock_sendv().
@@ -76,89 +75,12 @@ static erts_smp_rwmtx_t environ_rwmtx;
* Don't need global.h, but bif_table.h (included by bif.h),
* won't compile otherwise
*/
-#include "global.h"
+#include "global.h"
#include "bif.h"
-#include "erl_sys_driver.h"
#include "erl_check_io.h"
#include "erl_cpu_topology.h"
-#ifndef DISABLE_VFORK
-#define DISABLE_VFORK 0
-#endif
-
-#if defined IOV_MAX
-#define MAXIOV IOV_MAX
-#elif defined UIO_MAXIOV
-#define MAXIOV UIO_MAXIOV
-#else
-#define MAXIOV 16
-#endif
-
-#ifdef USE_THREADS
-# ifdef ENABLE_CHILD_WAITER_THREAD
-# define CHLDWTHR ENABLE_CHILD_WAITER_THREAD
-# else
-# define CHLDWTHR 0
-# endif
-# define FDBLOCK 1
-#else
-# define CHLDWTHR 0
-# define FDBLOCK 0
-#endif
-/*
- * [OTP-3906]
- * Solaris signal management gets confused when threads are used and a
- * lot of child processes dies. The confusion results in that SIGCHLD
- * signals aren't delivered to the emulator which in turn results in
- * a lot of defunct processes in the system.
- *
- * The problem seems to appear when a signal is frequently
- * blocked/unblocked at the same time as the signal is frequently
- * propagated. The child waiter thread is a workaround for this problem.
- * The SIGCHLD signal is always blocked (in all threads), and the child
- * waiter thread fetches the signal by a call to sigwait(). See
- * child_waiter().
- */
-
-typedef struct ErtsSysReportExit_ ErtsSysReportExit;
-struct ErtsSysReportExit_ {
- ErtsSysReportExit *next;
- Eterm port;
- int pid;
- int ifd;
- int ofd;
-#if CHLDWTHR && !defined(ERTS_SMP)
- int status;
-#endif
-};
-
-/* Used by the fd driver iff the fd could not be set to non-blocking */
-typedef struct ErtsSysBlocking_ {
- ErlDrvPDL pdl;
- int res;
- int err;
- unsigned int pkey;
-} ErtsSysBlocking;
-
-
-/* This data is shared by these drivers - initialized by spawn_init() */
-static struct driver_data {
- ErlDrvPort port_num;
- int ofd, packet_bytes;
- ErtsSysReportExit *report_exit;
- int pid;
- int alive;
- int status;
- int terminating;
- ErtsSysBlocking *blocking;
-} *driver_data; /* indexed by fd */
-
-static ErtsSysReportExit *report_exit_list;
-#if CHLDWTHR && !defined(ERTS_SMP)
-static ErtsSysReportExit *report_exit_transit_list;
-#endif
-
extern int driver_interrupt(int, int);
extern void do_break(void);
@@ -170,33 +92,6 @@ extern void erts_sys_init_float(void);
extern void erl_crash_dump(char* file, int line, char* fmt, ...);
-#define DIR_SEPARATOR_CHAR '/'
-
-#if defined(__ANDROID__)
-#define SHELL "/system/bin/sh"
-#else
-#define SHELL "/bin/sh"
-#endif /* __ANDROID__ */
-
-
-#if defined(DEBUG)
-#define ERL_BUILD_TYPE_MARKER ".debug"
-#elif defined(PURIFY)
-#define ERL_BUILD_TYPE_MARKER ".purify"
-#elif defined(QUANTIFY)
-#define ERL_BUILD_TYPE_MARKER ".quantify"
-#elif defined(PURECOV)
-#define ERL_BUILD_TYPE_MARKER ".purecov"
-#elif defined(VALGRIND)
-#define ERL_BUILD_TYPE_MARKER ".valgrind"
-#else /* opt */
-#define ERL_BUILD_TYPE_MARKER
-#endif
-
-#define CHILD_SETUP_PROG_NAME "child_setup" ERL_BUILD_TYPE_MARKER
-#if !DISABLE_VFORK
-static char *child_setup_prog;
-#endif
#ifdef DEBUG
static int debug_log = 0;
@@ -220,7 +115,7 @@ static volatile int have_prepared_crash_dump;
(have_prepared_crash_dump++)
#endif
-static erts_smp_atomic_t sys_misc_mem_sz;
+erts_smp_atomic_t sys_misc_mem_sz;
#if defined(ERTS_SMP)
static void smp_sig_notify(char c);
@@ -233,46 +128,6 @@ static int sig_suspend_fds[2] = {-1, -1};
jmp_buf erts_sys_sigsegv_jmp;
-#if CHLDWTHR || defined(ERTS_SMP)
-erts_mtx_t chld_stat_mtx;
-#endif
-#if CHLDWTHR
-static erts_tid_t child_waiter_tid;
-/* chld_stat_mtx is used to protect against concurrent accesses
- of the driver_data fields pid, alive, and status. */
-erts_cnd_t chld_stat_cnd;
-static long children_alive;
-#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx)
-#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx)
-#define CHLD_STAT_WAIT erts_cnd_wait(&chld_stat_cnd, &chld_stat_mtx)
-#define CHLD_STAT_SIGNAL erts_cnd_signal(&chld_stat_cnd)
-#elif defined(ERTS_SMP) /* ------------------------------------------------- */
-#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx)
-#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx)
-
-#else /* ------------------------------------------------------------------- */
-#define CHLD_STAT_LOCK
-#define CHLD_STAT_UNLOCK
-static volatile int children_died;
-#endif
-
-
-static struct fd_data {
- char pbuf[4]; /* hold partial packet bytes */
- int psz; /* size of pbuf */
- char *buf;
- char *cpos;
- int sz;
- int remain; /* for input on fd */
-} *fd_data; /* indexed by fd */
-
-/* static FUNCTION(int, write_fill, (int, char*, int)); unused? */
-static void note_child_death(int, int);
-
-#if CHLDWTHR
-static void* child_waiter(void *);
-#endif
-
static int crashdump_companion_cube_fd = -1;
/********************* General functions ****************************/
@@ -453,9 +308,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.
*/
@@ -551,14 +407,11 @@ erts_sys_pre_init(void)
#ifdef ERTS_THR_HAVE_SIG_FUNCS
sigemptyset(&thr_create_sigmask);
sigaddset(&thr_create_sigmask, SIGINT); /* block interrupt */
- sigaddset(&thr_create_sigmask, SIGCHLD); /* block child signals */
sigaddset(&thr_create_sigmask, SIGUSR1); /* block user defined signal */
#endif
erts_thr_init(&eid);
- report_exit_list = NULL;
-
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_init();
#endif
@@ -569,17 +422,6 @@ erts_sys_pre_init(void)
#ifdef USE_THREADS
-#if CHLDWTHR || defined(ERTS_SMP)
- erts_mtx_init(&chld_stat_mtx, "child_status");
-#endif
-#if CHLDWTHR
-#ifndef ERTS_SMP
- report_exit_transit_list = NULL;
-#endif
- erts_cnd_init(&chld_stat_cnd);
- children_alive = 0;
-#endif
-
#ifdef ERTS_SMP
erts_smp_atomic32_init_nob(&erts_break_requested, 0);
erts_smp_atomic32_init_nob(&erts_got_sigusr1, 0);
@@ -589,9 +431,6 @@ erts_sys_pre_init(void)
erts_got_sigusr1 = 0;
have_prepared_crash_dump = 0;
#endif
-#if !CHLDWTHR && !defined(ERTS_SMP)
- children_died = 0;
-#endif
#endif /* USE_THREADS */
@@ -628,39 +467,6 @@ erts_sys_pre_init(void)
void
erl_sys_init(void)
{
-#if !DISABLE_VFORK
- {
- int res;
- char bindir[MAXPATHLEN];
- size_t bindirsz = sizeof(bindir);
- Uint csp_path_sz;
-
- res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz);
- if (res != 0) {
- if (res < 0)
- erl_exit(-1,
- "Environment variable BINDIR is not set\n");
- if (res > 0)
- erl_exit(-1,
- "Value of environment variable BINDIR is too large\n");
- }
- if (bindir[0] != DIR_SEPARATOR_CHAR)
- erl_exit(-1,
- "Environment variable BINDIR does not contain an"
- " absolute path\n");
- csp_path_sz = (strlen(bindir)
- + 1 /* DIR_SEPARATOR_CHAR */
- + sizeof(CHILD_SETUP_PROG_NAME)
- + 1);
- child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, csp_path_sz);
- erts_snprintf(child_setup_prog, csp_path_sz,
- "%s%c%s",
- bindir,
- DIR_SEPARATOR_CHAR,
- CHILD_SETUP_PROG_NAME);
- }
-#endif
#ifdef USE_SETLINEBUF
setlinebuf(stdout);
@@ -978,43 +784,6 @@ int sys_max_files(void)
return(max_files);
}
-static void block_signals(void)
-{
-#if !CHLDWTHR
- sys_sigblock(SIGCHLD);
-#endif
-#ifndef ERTS_SMP
- sys_sigblock(SIGINT);
-#ifndef ETHR_UNUSABLE_SIGUSRX
- sys_sigblock(SIGUSR1);
-#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */
-#endif /* #ifndef ERTS_SMP */
-
-#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX)
- sys_sigblock(ERTS_SYS_SUSPEND_SIGNAL);
-#endif
-
-}
-
-static void unblock_signals(void)
-{
- /* Update erl_child_setup.c if changed */
-#if !CHLDWTHR
- sys_sigrelease(SIGCHLD);
-#endif
-#ifndef ERTS_SMP
- sys_sigrelease(SIGINT);
-#ifndef ETHR_UNUSABLE_SIGUSRX
- sys_sigrelease(SIGUSR1);
-#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */
-#endif /* #ifndef ERTS_SMP */
-
-#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX)
- sys_sigrelease(ERTS_SYS_SUSPEND_SIGNAL);
-#endif
-
-}
-
/************************** OS info *******************************/
/* Used by erlang:info/1. */
@@ -1102,1502 +871,6 @@ void fini_getenv_state(GETENV_STATE *state)
erts_smp_rwmtx_runlock(&environ_rwmtx);
}
-
-/************************** Port I/O *******************************/
-
-
-
-/* I. Common stuff */
-
-/*
- * Decreasing the size of it below 16384 is not allowed.
- */
-
-/* II. The spawn/fd/vanilla drivers */
-
-#define ERTS_SYS_READ_BUF_SZ (64*1024)
-
-/* Driver interfaces */
-static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*);
-static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*);
-#if FDBLOCK
-static void fd_async(void *);
-static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data);
-#endif
-static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT,
- char **, ErlDrvSizeT);
-static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*);
-static int spawn_init(void);
-static void fd_stop(ErlDrvData);
-static void fd_flush(ErlDrvData);
-static void stop(ErlDrvData);
-static void ready_input(ErlDrvData, ErlDrvEvent);
-static void ready_output(ErlDrvData, ErlDrvEvent);
-static void output(ErlDrvData, char*, ErlDrvSizeT);
-static void outputv(ErlDrvData, ErlIOVec*);
-static void stop_select(ErlDrvEvent, void*);
-
-struct erl_drv_entry spawn_driver_entry = {
- spawn_init,
- spawn_start,
- stop,
- output,
- ready_input,
- ready_output,
- "spawn",
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- ERL_DRV_FLAG_USE_PORT_LOCKING,
- NULL, NULL,
- stop_select
-};
-struct erl_drv_entry fd_driver_entry = {
- NULL,
- fd_start,
- fd_stop,
- output,
- ready_input,
- ready_output,
- "fd",
- NULL,
- NULL,
- fd_control,
- NULL,
- outputv,
-#if FDBLOCK
- fd_ready_async, /* ready_async */
-#else
- NULL,
-#endif
- fd_flush, /* flush */
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0, /* ERL_DRV_FLAGs */
- NULL, /* handle2 */
- NULL, /* process_exit */
- stop_select
-};
-struct erl_drv_entry vanilla_driver_entry = {
- NULL,
- vanilla_start,
- stop,
- output,
- ready_input,
- ready_output,
- "vanilla",
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL, /* flush */
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0, /* ERL_DRV_FLAGs */
- NULL, /* handle2 */
- NULL, /* process_exit */
- stop_select
-};
-
-/* Handle SIGCHLD signals. */
-#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL))
-static RETSIGTYPE onchld(void)
-#else
-static RETSIGTYPE onchld(int signum)
-#endif
-{
-#if CHLDWTHR
- ASSERT(0); /* We should *never* catch a SIGCHLD signal */
-#elif defined(ERTS_SMP)
- smp_sig_notify('C');
-#else
- children_died = 1;
- ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
-#endif
-}
-
-static int set_blocking_data(struct driver_data *dd) {
-
- dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking));
-
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking));
-
- dd->blocking->pdl = driver_pdl_create(dd->port_num);
- dd->blocking->res = 0;
- dd->blocking->err = 0;
- dd->blocking->pkey = driver_async_port_key(dd->port_num);
-
- return 1;
-}
-
-static int set_driver_data(ErlDrvPort port_num,
- int ifd,
- int ofd,
- int packet_bytes,
- int read_write,
- int exit_status,
- int pid,
- int is_blocking)
-{
- Port *prt;
- ErtsSysReportExit *report_exit;
-
- if (!exit_status)
- report_exit = NULL;
- else {
- report_exit = erts_alloc(ERTS_ALC_T_PRT_REP_EXIT,
- sizeof(ErtsSysReportExit));
- report_exit->next = report_exit_list;
- report_exit->port = erts_drvport2id(port_num);
- report_exit->pid = pid;
- report_exit->ifd = read_write & DO_READ ? ifd : -1;
- report_exit->ofd = read_write & DO_WRITE ? ofd : -1;
-#if CHLDWTHR && !defined(ERTS_SMP)
- report_exit->status = 0;
-#endif
- report_exit_list = report_exit;
- }
-
- prt = erts_drvport2port(port_num);
- if (prt != ERTS_INVALID_ERL_DRV_PORT)
- prt->os_pid = pid;
-
- if (read_write & DO_READ) {
- driver_data[ifd].packet_bytes = packet_bytes;
- driver_data[ifd].port_num = port_num;
- driver_data[ifd].report_exit = report_exit;
- driver_data[ifd].pid = pid;
- driver_data[ifd].alive = 1;
- driver_data[ifd].status = 0;
- driver_data[ifd].terminating = 0;
- driver_data[ifd].blocking = NULL;
- if (read_write & DO_WRITE) {
- driver_data[ifd].ofd = ofd;
- if (is_blocking && FDBLOCK)
- if (!set_blocking_data(driver_data+ifd))
- return -1;
- if (ifd != ofd)
- driver_data[ofd] = driver_data[ifd]; /* structure copy */
- } else { /* DO_READ only */
- driver_data[ifd].ofd = -1;
- }
- (void) driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1);
- return(ifd);
- } else { /* DO_WRITE only */
- driver_data[ofd].packet_bytes = packet_bytes;
- driver_data[ofd].port_num = port_num;
- driver_data[ofd].report_exit = report_exit;
- driver_data[ofd].ofd = ofd;
- driver_data[ofd].pid = pid;
- driver_data[ofd].alive = 1;
- driver_data[ofd].status = 0;
- driver_data[ofd].terminating = 0;
- driver_data[ofd].blocking = NULL;
- if (is_blocking && FDBLOCK)
- if (!set_blocking_data(driver_data+ofd))
- return -1;
- return(ofd);
- }
-}
-
-static int spawn_init()
-{
- int i;
-#if CHLDWTHR
- erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
-
- thr_opts.detached = 0;
- thr_opts.suggested_stack_size = 0; /* Smallest possible */
- thr_opts.name = "child_waiter";
-#endif
-
- sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */
- driver_data = (struct driver_data *)
- erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data));
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
- max_files * sizeof(struct driver_data));
-
- for (i = 0; i < max_files; i++)
- driver_data[i].pid = -1;
-
-#if CHLDWTHR
- sys_sigblock(SIGCHLD);
-#endif
-
- sys_signal(SIGCHLD, onchld); /* Reap children */
-
-#if CHLDWTHR
- erts_thr_create(&child_waiter_tid, child_waiter, NULL, &thr_opts);
-#endif
-
- return 1;
-}
-
-static void close_pipes(int ifd[2], int ofd[2], int read_write)
-{
- if (read_write & DO_READ) {
- (void) close(ifd[0]);
- (void) close(ifd[1]);
- }
- if (read_write & DO_WRITE) {
- (void) close(ofd[0]);
- (void) close(ofd[1]);
- }
-}
-
-static void init_fd_data(int fd, ErlDrvPort port_num)
-{
- fd_data[fd].buf = NULL;
- fd_data[fd].cpos = NULL;
- fd_data[fd].remain = 0;
- fd_data[fd].sz = 0;
- fd_data[fd].psz = 0;
-}
-
-static char **build_unix_environment(char *block)
-{
- int i;
- int j;
- int len;
- char *cp;
- char **cpp;
- char** old_env;
-
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx));
-
- cp = block;
- len = 0;
- while (*cp != '\0') {
- cp += strlen(cp) + 1;
- len++;
- }
- old_env = environ;
- while (*old_env++ != NULL) {
- len++;
- }
-
- cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT,
- sizeof(char *) * (len+1));
- if (cpp == NULL) {
- return NULL;
- }
-
- cp = block;
- len = 0;
- while (*cp != '\0') {
- cpp[len] = cp;
- cp += strlen(cp) + 1;
- len++;
- }
-
- i = len;
- for (old_env = environ; *old_env; old_env++) {
- char* old = *old_env;
-
- for (j = 0; j < len; j++) {
- char *s, *t;
-
- s = cpp[j];
- t = old;
- while (*s == *t && *s != '=') {
- s++, t++;
- }
- if (*s == '=' && *t == '=') {
- break;
- }
- }
-
- if (j == len) { /* New version not found */
- cpp[len++] = old;
- }
- }
-
- for (j = 0; j < i; ) {
- size_t last = strlen(cpp[j])-1;
- if (cpp[j][last] == '=' && strchr(cpp[j], '=') == cpp[j]+last) {
- cpp[j] = cpp[--len];
- if (len < i) {
- i--;
- } else {
- j++;
- }
- }
- else {
- j++;
- }
- }
-
- cpp[len] = NULL;
- return cpp;
-}
-
-/*
- [arndt] In most Unix systems, including Solaris 2.5, 'fork' allocates memory
- in swap space for the child of a 'fork', whereas 'vfork' does not do this.
- The natural call to use here is therefore 'vfork'. Due to a bug in
- 'vfork' in Solaris 2.5 (apparently fixed in 2.6), using 'vfork'
- can be dangerous in what seems to be these circumstances:
- If the child code under a vfork sets the signal action to SIG_DFL
- (or SIG_IGN)
- for any signal which was previously set to a signal handler, the
- state of the parent is clobbered, so that the later arrival of
- such a signal yields a sigsegv in the parent. If the signal was
- not set to a signal handler, but ignored, all seems to work.
- If you change the forking code below, beware of this.
- */
-
-static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts)
-{
-#define CMD_LINE_PREFIX_STR "exec "
-#define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1)
-
- int ifd[2], ofd[2], len, pid, i;
- char **volatile new_environ; /* volatile since a vfork() then cannot
- cause 'new_environ' to be clobbered
- in the parent process. */
- int saved_errno;
- long res;
- char *cmd_line;
-#ifndef QNX
- int unbind;
-#endif
-#if !DISABLE_VFORK
- int no_vfork;
- size_t no_vfork_sz = sizeof(no_vfork);
-
- no_vfork = (erts_sys_getenv_raw("ERL_NO_VFORK",
- (char *) &no_vfork,
- &no_vfork_sz) >= 0);
-#endif
-
- switch (opts->read_write) {
- case DO_READ:
- if (pipe(ifd) < 0)
- return ERL_DRV_ERROR_ERRNO;
- if (ifd[0] >= max_files) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = EMFILE;
- return ERL_DRV_ERROR_ERRNO;
- }
- ofd[1] = -1; /* keep purify happy */
- break;
- case DO_WRITE:
- if (pipe(ofd) < 0) return ERL_DRV_ERROR_ERRNO;
- if (ofd[1] >= max_files) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = EMFILE;
- return ERL_DRV_ERROR_ERRNO;
- }
- ifd[0] = -1; /* keep purify happy */
- break;
- case DO_READ|DO_WRITE:
- if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO;
- errno = EMFILE; /* default for next two conditions */
- if (ifd[0] >= max_files || pipe(ofd) < 0) {
- close_pipes(ifd, ofd, DO_READ);
- return ERL_DRV_ERROR_ERRNO;
- }
- if (ofd[1] >= max_files) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = EMFILE;
- return ERL_DRV_ERROR_ERRNO;
- }
- break;
- default:
- ASSERT(0);
- return ERL_DRV_ERROR_GENERAL;
- }
-
- if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
- /* started with spawn_executable, not with spawn */
- len = strlen(name);
- cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1);
- if (!cmd_line) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = ENOMEM;
- return ERL_DRV_ERROR_ERRNO;
- }
- memcpy((void *) cmd_line,(void *) name, len);
- cmd_line[len] = '\0';
- if (access(cmd_line,X_OK) != 0) {
- int save_errno = errno;
- erts_free(ERTS_ALC_T_TMP, cmd_line);
- errno = save_errno;
- return ERL_DRV_ERROR_ERRNO;
- }
- } else {
- /* make the string suitable for giving to "sh" */
- len = strlen(name);
- cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP,
- CMD_LINE_PREFIX_STR_SZ + len + 1);
- if (!cmd_line) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = ENOMEM;
- return ERL_DRV_ERROR_ERRNO;
- }
- memcpy((void *) cmd_line,
- (void *) CMD_LINE_PREFIX_STR,
- CMD_LINE_PREFIX_STR_SZ);
- memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len);
- cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0';
- }
-
- erts_smp_rwmtx_rlock(&environ_rwmtx);
-
- if (opts->envir == NULL) {
- new_environ = environ;
- } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) {
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
- errno = ENOMEM;
- return ERL_DRV_ERROR_ERRNO;
- }
-
-#ifndef QNX
- /* Block child from SIGINT and SIGUSR1. Must be before fork()
- to be safe. */
- block_signals();
-
- CHLD_STAT_LOCK;
-
- unbind = erts_sched_bind_atfork_prepare();
-
-#if !DISABLE_VFORK
- /* See fork/vfork discussion before this function. */
- if (no_vfork) {
-#endif
-
- DEBUGF(("Using fork\n"));
- pid = fork();
-
- if (pid == 0) {
- /* The child! Setup child... */
-
- if (erts_sched_bind_atfork_child(unbind) != 0)
- goto child_error;
-
- /* OBSERVE!
- * Keep child setup after vfork() (implemented below and in
- * erl_child_setup.c) up to date if changes are made here.
- */
-
- if (opts->use_stdio) {
- if (opts->read_write & DO_READ) {
- /* stdout for process */
- if (dup2(ifd[1], 1) < 0)
- goto child_error;
- if(opts->redir_stderr)
- /* stderr for process */
- if (dup2(ifd[1], 2) < 0)
- goto child_error;
- }
- if (opts->read_write & DO_WRITE)
- /* stdin for process */
- if (dup2(ofd[0], 0) < 0)
- goto child_error;
- }
- else { /* XXX will fail if ofd[0] == 4 (unlikely..) */
- if (opts->read_write & DO_READ)
- if (dup2(ifd[1], 4) < 0)
- goto child_error;
- if (opts->read_write & DO_WRITE)
- if (dup2(ofd[0], 3) < 0)
- goto child_error;
- }
-
-#if defined(HAVE_CLOSEFROM)
- closefrom(opts->use_stdio ? 3 : 5);
-#else
- for (i = opts->use_stdio ? 3 : 5; i < max_files; i++)
- (void) close(i);
-#endif
-
- if (opts->wd && chdir(opts->wd) < 0)
- goto child_error;
-
-#if defined(USE_SETPGRP_NOARGS) /* SysV */
- (void) setpgrp();
-#elif defined(USE_SETPGRP) /* BSD */
- (void) setpgrp(0, getpid());
-#else /* POSIX */
- (void) setsid();
-#endif
-
- unblock_signals();
-
- if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
- if (opts->argv == NULL) {
- execle(cmd_line,cmd_line,(char *) NULL, new_environ);
- } else {
- if (opts->argv[0] == erts_default_arg0) {
- opts->argv[0] = cmd_line;
- }
- execve(cmd_line, opts->argv, new_environ);
- if (opts->argv[0] == cmd_line) {
- opts->argv[0] = erts_default_arg0;
- }
- }
- } else {
- execle(SHELL, "sh", "-c", cmd_line, (char *) NULL, new_environ);
- }
- child_error:
- _exit(1);
- }
-#if !DISABLE_VFORK
- }
-#define ENOUGH_BYTES (44)
- else { /* Use vfork() */
- char **cs_argv= erts_alloc(ERTS_ALC_T_TMP,(CS_ARGV_NO_OF_ARGS + 1)*
- sizeof(char *));
- char fd_close_range[ENOUGH_BYTES]; /* 44 bytes are enough to */
- char dup2_op[CS_ARGV_NO_OF_DUP2_OPS][ENOUGH_BYTES]; /* hold any "%d:%d" string */
- /* on a 64-bit machine. */
-
- /* Setup argv[] for the child setup program (implemented in
- erl_child_setup.c) */
- i = 0;
- if (opts->use_stdio) {
- if (opts->read_write & DO_READ){
- /* stdout for process */
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 1);
- if(opts->redir_stderr)
- /* stderr for process */
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 2);
- }
- if (opts->read_write & DO_WRITE)
- /* stdin for process */
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 0);
- } else { /* XXX will fail if ofd[0] == 4 (unlikely..) */
- if (opts->read_write & DO_READ)
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 4);
- if (opts->read_write & DO_WRITE)
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 3);
- }
- for (; i < CS_ARGV_NO_OF_DUP2_OPS; i++)
- strcpy(&dup2_op[i][0], "-");
- erts_snprintf(fd_close_range, ENOUGH_BYTES, "%d:%d", opts->use_stdio ? 3 : 5, max_files-1);
-
- cs_argv[CS_ARGV_PROGNAME_IX] = child_setup_prog;
- cs_argv[CS_ARGV_WD_IX] = opts->wd ? opts->wd : ".";
- cs_argv[CS_ARGV_UNBIND_IX] = erts_sched_bind_atvfork_child(unbind);
- cs_argv[CS_ARGV_FD_CR_IX] = fd_close_range;
- for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++)
- cs_argv[CS_ARGV_DUP2_OP_IX(i)] = &dup2_op[i][0];
-
- if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
- int num = 0;
- int j = 0;
- if (opts->argv != NULL) {
- for(; opts->argv[num] != NULL; ++num)
- ;
- }
- cs_argv = erts_realloc(ERTS_ALC_T_TMP,cs_argv, (CS_ARGV_NO_OF_ARGS + 1 + num + 1) * sizeof(char *));
- cs_argv[CS_ARGV_CMD_IX] = "-";
- cs_argv[CS_ARGV_NO_OF_ARGS] = cmd_line;
- if (opts->argv != NULL) {
- for (;opts->argv[j] != NULL; ++j) {
- if (opts->argv[j] == erts_default_arg0) {
- cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = cmd_line;
- } else {
- cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = opts->argv[j];
- }
- }
- }
- cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = NULL;
- } else {
- cs_argv[CS_ARGV_CMD_IX] = cmd_line; /* Command */
- cs_argv[CS_ARGV_NO_OF_ARGS] = NULL;
- }
- DEBUGF(("Using vfork\n"));
- pid = vfork();
-
- if (pid == 0) {
- /* The child! */
-
- /* Observe!
- * OTP-4389: The child setup program (implemented in
- * erl_child_setup.c) will perform the necessary setup of the
- * child before it execs to the user program. This because
- * vfork() only allow an *immediate* execve() or _exit() in the
- * child.
- */
- execve(child_setup_prog, cs_argv, new_environ);
- _exit(1);
- }
- erts_free(ERTS_ALC_T_TMP,cs_argv);
- }
-#undef ENOUGH_BYTES
-#endif
-
- erts_sched_bind_atfork_parent(unbind);
-
- if (pid == -1) {
- saved_errno = errno;
- CHLD_STAT_UNLOCK;
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
- unblock_signals();
- close_pipes(ifd, ofd, opts->read_write);
- errno = saved_errno;
- return ERL_DRV_ERROR_ERRNO;
- }
-#else /* QNX */
- if (opts->use_stdio) {
- if (opts->read_write & DO_READ)
- qnx_spawn_options.iov[1] = ifd[1]; /* stdout for process */
- if (opts->read_write & DO_WRITE)
- qnx_spawn_options.iov[0] = ofd[0]; /* stdin for process */
- }
- else {
- if (opts->read_write & DO_READ)
- qnx_spawn_options.iov[4] = ifd[1];
- if (opts->read_write & DO_WRITE)
- qnx_spawn_options.iov[3] = ofd[0];
- }
- /* Close fds on exec */
- for (i = 3; i < max_files; i++)
- fcntl(i, F_SETFD, 1);
-
- qnx_spawn_options.flags = _SPAWN_SETSID;
- if ((pid = spawnl(P_NOWAIT, SHELL, SHELL, "-c", cmd_line,
- (char *) 0)) < 0) {
- erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
- reset_qnx_spawn();
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- close_pipes(ifd, ofd, opts->read_write);
- return ERL_DRV_ERROR_GENERAL;
- }
- reset_qnx_spawn();
-#endif /* QNX */
-
- erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
-
- if (new_environ != environ)
- erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
-
- if (opts->read_write & DO_READ)
- (void) close(ifd[1]);
- if (opts->read_write & DO_WRITE)
- (void) close(ofd[0]);
-
- if (opts->read_write & DO_READ) {
- SET_NONBLOCKING(ifd[0]);
- init_fd_data(ifd[0], port_num);
- }
- if (opts->read_write & DO_WRITE) {
- SET_NONBLOCKING(ofd[1]);
- init_fd_data(ofd[1], port_num);
- }
-
- res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes,
- opts->read_write, opts->exit_status, pid, 0);
- /* Don't unblock SIGCHLD until now, since the call above must
- first complete putting away the info about our new subprocess. */
- unblock_signals();
-
-#if CHLDWTHR
- ASSERT(children_alive >= 0);
-
- if (!(children_alive++))
- CHLD_STAT_SIGNAL; /* Wake up child waiter thread if no children
- was alive before we fork()ed ... */
-#endif
- /* Don't unlock chld_stat_mtx until now of the same reason as above */
- CHLD_STAT_UNLOCK;
-
- erts_smp_rwmtx_runlock(&environ_rwmtx);
-
- return (ErlDrvData)res;
-#undef CMD_LINE_PREFIX_STR
-#undef CMD_LINE_PREFIX_STR_SZ
-}
-
-#ifdef QNX
-static reset_qnx_spawn()
-{
- int i;
-
- /* Reset qnx_spawn_options */
- qnx_spawn_options.flags = 0;
- qnx_spawn_options.iov[0] = 0xff;
- qnx_spawn_options.iov[1] = 0xff;
- qnx_spawn_options.iov[2] = 0xff;
- qnx_spawn_options.iov[3] = 0xff;
-}
-#endif
-
-#define FD_DEF_HEIGHT 24
-#define FD_DEF_WIDTH 80
-/* Control op */
-#define FD_CTRL_OP_GET_WINSIZE 100
-
-static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height)
-{
-#ifdef TIOCGWINSZ
- struct winsize ws;
- if (ioctl(fd,TIOCGWINSZ,&ws) == 0) {
- *width = (Uint32) ws.ws_col;
- *height = (Uint32) ws.ws_row;
- return 0;
- }
-#endif
- return -1;
-}
-
-static ErlDrvSSizeT fd_control(ErlDrvData drv_data,
- unsigned int command,
- char *buf, ErlDrvSizeT len,
- char **rbuf, ErlDrvSizeT rlen)
-{
- int fd = (int)(long)drv_data;
- char resbuff[2*sizeof(Uint32)];
- switch (command) {
- case FD_CTRL_OP_GET_WINSIZE:
- {
- Uint32 w,h;
- if (fd_get_window_size(fd,&w,&h))
- return 0;
- memcpy(resbuff,&w,sizeof(Uint32));
- memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32));
- }
- break;
- default:
- return 0;
- }
- if (rlen < 2*sizeof(Uint32)) {
- *rbuf = driver_alloc(2*sizeof(Uint32));
- }
- memcpy(*rbuf,resbuff,2*sizeof(Uint32));
- return 2*sizeof(Uint32);
-}
-
-static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
- SysDriverOpts* opts)
-{
- ErlDrvData res;
- int non_blocking = 0;
-
- if (((opts->read_write & DO_READ) && opts->ifd >= max_files) ||
- ((opts->read_write & DO_WRITE) && opts->ofd >= max_files))
- return ERL_DRV_ERROR_GENERAL;
-
- /*
- * Historical:
- *
- * "Note about nonblocking I/O.
- *
- * At least on Solaris, setting the write end of a TTY to nonblocking,
- * will set the input end to nonblocking as well (and vice-versa).
- * If erl is run in a pipeline like this: cat | erl
- * the input end of the TTY will be the standard input of cat.
- * And cat is not prepared to handle nonblocking I/O."
- *
- * Actually, the reason for this is not that the tty itself gets set
- * in non-blocking mode, but that the "input end" (cat's stdin) and
- * the "output end" (erlang's stdout) are typically the "same" file
- * descriptor, dup()'ed from a single fd by one of this process'
- * ancestors.
- *
- * The workaround for this problem used to be a rather bad kludge,
- * interposing an extra process ("internal cat") between erlang's
- * stdout and the original stdout, allowing erlang to set its stdout
- * in non-blocking mode without affecting the stdin of the preceding
- * process in the pipeline - and being a kludge, it caused all kinds
- * of weird problems.
- *
- * So, this is the current logic:
- *
- * The only reason to set non-blocking mode on the output fd at all is
- * if it's something that can cause a write() to block, of course,
- * i.e. primarily if it points to a tty, socket, pipe, or fifo.
- *
- * If we don't set non-blocking mode when we "should" have, and output
- * becomes blocked, the entire runtime system will be suspended - this
- * is normally bad of course, and can happen fairly "easily" - e.g. user
- * hits ^S on tty - but doesn't necessarily happen.
- *
- * If we do set non-blocking mode when we "shouldn't" have, the runtime
- * system will end up seeing EOF on the input fd (due to the preceding
- * process dying), which typically will cause the entire runtime system
- * to terminate immediately (due to whatever erlang process is seeing
- * the EOF taking it as a signal to halt the system). This is *very* bad.
- *
- * I.e. we should take a conservative approach, and only set non-
- * blocking mode when we a) need to, and b) are reasonably certain
- * that it won't be a problem. And as in the example above, the problem
- * occurs when input fd and output fd point to different "things".
- *
- * However, determining that they are not just the same "type" of
- * "thing", but actually the same instance of that type of thing, is
- * unreasonably complex in many/most cases.
- *
- * Also, with pipes, sockets, and fifos it's far from obvious that the
- * user *wants* non-blocking output: If you're running erlang inside
- * some complex pipeline, you're probably not running a real-time system
- * that must never stop, but rather *want* it to suspend if the output
- * channel is "full".
- *
- * So, the bottom line: We will only set the output fd non-blocking if
- * it points to a tty, and either a) the input fd also points to a tty,
- * or b) we can make sure that setting the output fd non-blocking
- * doesn't interfere with someone else's input, via a somewhat milder
- * kludge than the above.
- *
- * Also keep in mind that while this code is almost exclusively run as
- * a result of an erlang open_port({fd,0,1}, ...), that isn't the only
- * case - it can be called with any old pre-existing file descriptors,
- * the relations between which (if they're even two) we can only guess
- * at - still, we try our best...
- *
- * Added note OTP 18: Some systems seem to use stdout/stderr to log data
- * using unix pipes, so we cannot allow the system to block on a write.
- * Therefore we use an async thread to write the data to fd's that could
- * not be set to non-blocking. When no async threads are available we
- * fall back on the old behaviour.
- *
- * Also the guarantee about what is delivered to the OS has changed.
- * Pre 18 the fd driver did no flushing of data before terminating.
- * Now it does. This is because we want to be able to guarantee that things
- * such as escripts and friends really have outputted all data before
- * terminating. This could potentially block the termination of the system
- * for a very long time, but if the user wants to terminate fast she should
- * use erlang:halt with flush=false.
- */
-
- if (opts->read_write & DO_READ) {
- init_fd_data(opts->ifd, port_num);
- }
- if (opts->read_write & DO_WRITE) {
- init_fd_data(opts->ofd, port_num);
-
- /* If we don't have a read end, all bets are off - no non-blocking. */
- if (opts->read_write & DO_READ) {
-
- if (isatty(opts->ofd)) { /* output fd is a tty:-) */
-
- if (isatty(opts->ifd)) { /* input fd is also a tty */
-
- /* To really do this "right", we should also check that
- input and output fd point to the *same* tty - but
- this seems like overkill; ttyname() isn't for free,
- and this is a very common case - and it's hard to
- imagine a scenario where setting non-blocking mode
- here would cause problems - go ahead and do it. */
-
- non_blocking = 1;
- SET_NONBLOCKING(opts->ofd);
-
- } else { /* output fd is a tty, input fd isn't */
-
- /* This is a "problem case", but also common (see the
- example above) - i.e. it makes sense to try a bit
- harder before giving up on non-blocking mode: Try to
- re-open the tty that the output fd points to, and if
- successful replace the original one with the "new" fd
- obtained this way, and set *that* one in non-blocking
- mode. (Yes, this is a kludge.)
-
- However, re-opening the tty may fail in a couple of
- (unusual) cases:
-
- 1) The name of the tty (or an equivalent one, i.e.
- same major/minor number) can't be found, because
- it actually lives somewhere other than /dev (or
- wherever ttyname() looks for it), and isn't
- equivalent to any of those that do live in the
- "standard" place - this should be *very* unusual.
-
- 2) Permissions on the tty don't allow us to open it -
- it's perfectly possible to have an fd open to an
- object whose permissions wouldn't allow us to open
- it. This is not as unusual as it sounds, one case
- is if the user has su'ed to someone else (not
- root) - we have a read/write fd open to the tty
- (because it has been inherited all the way down
- here), but we have neither read nor write
- permission for the tty.
-
- In these cases, we finally give up, and don't set the
- output fd in non-blocking mode. */
-
- char *tty;
- int nfd;
-
- if ((tty = ttyname(opts->ofd)) != NULL &&
- (nfd = open(tty, O_WRONLY)) != -1) {
- dup2(nfd, opts->ofd);
- close(nfd);
- non_blocking = 1;
- SET_NONBLOCKING(opts->ofd);
- }
- }
- }
- }
- }
- CHLD_STAT_LOCK;
- res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd,
- opts->packet_bytes,
- opts->read_write, 0, -1,
- !non_blocking);
- CHLD_STAT_UNLOCK;
- return res;
-}
-
-static void clear_fd_data(int fd)
-{
- if (fd_data[fd].sz > 0) {
- erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fd_data[fd].buf);
- ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fd_data[fd].sz);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fd_data[fd].sz);
- }
- fd_data[fd].buf = NULL;
- fd_data[fd].sz = 0;
- fd_data[fd].remain = 0;
- fd_data[fd].cpos = NULL;
- fd_data[fd].psz = 0;
-}
-
-static void nbio_stop_fd(ErlDrvPort prt, int fd)
-{
- driver_select(prt,fd,DO_READ|DO_WRITE,0);
- clear_fd_data(fd);
- SET_BLOCKING(fd);
-}
-
-static void fd_stop(ErlDrvData ev) /* Does not close the fds */
-{
- int ofd;
- int fd = (int)(long)ev;
- ErlDrvPort prt = driver_data[fd].port_num;
-
-#if FDBLOCK
- if (driver_data[fd].blocking) {
- erts_free(ERTS_ALC_T_SYS_BLOCKING,driver_data[fd].blocking);
- driver_data[fd].blocking = NULL;
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*sizeof(ErtsSysBlocking));
- }
-#endif
-
- nbio_stop_fd(prt, fd);
- ofd = driver_data[fd].ofd;
- if (ofd != fd && ofd != -1)
- nbio_stop_fd(prt, ofd);
-}
-
-static void fd_flush(ErlDrvData fd)
-{
- if (!driver_data[(int)(long)fd].terminating)
- driver_data[(int)(long)fd].terminating = 1;
-}
-
-static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name,
- SysDriverOpts* opts)
-{
- int flags, fd;
- ErlDrvData res;
-
- flags = (opts->read_write == DO_READ ? O_RDONLY :
- opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC :
- O_RDWR|O_CREAT);
- if ((fd = open(name, flags, 0666)) < 0)
- return ERL_DRV_ERROR_GENERAL;
- if (fd >= max_files) {
- close(fd);
- return ERL_DRV_ERROR_GENERAL;
- }
- SET_NONBLOCKING(fd);
- init_fd_data(fd, port_num);
-
- CHLD_STAT_LOCK;
- res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd,
- opts->packet_bytes,
- opts->read_write, 0, -1, 0);
- CHLD_STAT_UNLOCK;
- return res;
-}
-
-/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */
-/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */
-
-static void stop(ErlDrvData fd)
-{
- ErlDrvPort prt;
- int ofd;
-
- prt = driver_data[(int)(long)fd].port_num;
- nbio_stop_fd(prt, (int)(long)fd);
-
- ofd = driver_data[(int)(long)fd].ofd;
- if (ofd != (int)(long)fd && (int)(long)ofd != -1)
- nbio_stop_fd(prt, ofd);
- else
- ofd = -1;
-
- CHLD_STAT_LOCK;
-
- /* Mark as unused. */
- driver_data[(int)(long)fd].pid = -1;
-
- CHLD_STAT_UNLOCK;
-
- /* SMP note: Close has to be last thing done (open file descriptors work
- as locks on driver_data[] entries) */
- driver_select(prt, (int)(long)fd, ERL_DRV_USE, 0); /* close(fd); */
- if (ofd >= 0) {
- driver_select(prt, (int)(long)ofd, ERL_DRV_USE, 0); /* close(ofd); */
- }
-}
-
-/* used by fd_driver */
-static void outputv(ErlDrvData e, ErlIOVec* ev)
-{
- int fd = (int)(long)e;
- ErlDrvPort ix = driver_data[fd].port_num;
- int pb = driver_data[fd].packet_bytes;
- int ofd = driver_data[fd].ofd;
- ssize_t n;
- ErlDrvSizeT sz;
- char lb[4];
- char* lbp;
- ErlDrvSizeT len = ev->size;
-
- /* (len > ((unsigned long)-1 >> (4-pb)*8)) */
- /* if (pb >= 0 && (len & (((ErlDrvSizeT)1 << (pb*8))) - 1) != len) {*/
- if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) {
- driver_failure_posix(ix, EINVAL);
- return; /* -1; */
- }
- /* Handles 0 <= pb <= 4 only */
- put_int32((Uint32) len, lb);
- lbp = lb + (4-pb);
-
- ev->iov[0].iov_base = lbp;
- ev->iov[0].iov_len = pb;
- ev->size += pb;
-
- if (driver_data[fd].blocking && FDBLOCK)
- driver_pdl_lock(driver_data[fd].blocking->pdl);
-
- if ((sz = driver_sizeq(ix)) > 0) {
- driver_enqv(ix, ev, 0);
-
- if (driver_data[fd].blocking && FDBLOCK)
- driver_pdl_unlock(driver_data[fd].blocking->pdl);
-
- if (sz + ev->size >= (1 << 13))
- set_busy_port(ix, 1);
- }
- else if (!driver_data[fd].blocking || !FDBLOCK) {
- /* We try to write directly if the fd in non-blocking */
- int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize;
-
- n = writev(ofd, (const void *) (ev->iov), vsize);
- if (n == ev->size)
- return; /* 0;*/
- if (n < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
- driver_failure_posix(ix, errno);
- return; /* -1;*/
- }
- n = 0;
- }
- driver_enqv(ix, ev, n); /* n is the skip value */
- driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
- }
-#if FDBLOCK
- else {
- if (ev->size != 0) {
- driver_enqv(ix, ev, 0);
- driver_pdl_unlock(driver_data[fd].blocking->pdl);
- driver_async(ix, &driver_data[fd].blocking->pkey,
- fd_async, driver_data+fd, NULL);
- } else {
- driver_pdl_unlock(driver_data[fd].blocking->pdl);
- }
- }
-#endif
- /* return 0;*/
-}
-
-/* Used by spawn_driver and vanilla driver */
-static void output(ErlDrvData e, char* buf, ErlDrvSizeT len)
-{
- int fd = (int)(long)e;
- ErlDrvPort ix = driver_data[fd].port_num;
- int pb = driver_data[fd].packet_bytes;
- int ofd = driver_data[fd].ofd;
- ssize_t n;
- ErlDrvSizeT sz;
- char lb[4];
- char* lbp;
- struct iovec iv[2];
-
- /* (len > ((unsigned long)-1 >> (4-pb)*8)) */
- if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) {
- driver_failure_posix(ix, EINVAL);
- return; /* -1; */
- }
- put_int32(len, lb);
- lbp = lb + (4-pb);
-
- if ((sz = driver_sizeq(ix)) > 0) {
- driver_enq(ix, lbp, pb);
- driver_enq(ix, buf, len);
- if (sz + len + pb >= (1 << 13))
- set_busy_port(ix, 1);
- }
- else {
- iv[0].iov_base = lbp;
- iv[0].iov_len = pb; /* should work for pb=0 */
- iv[1].iov_base = buf;
- iv[1].iov_len = len;
- n = writev(ofd, iv, 2);
- if (n == pb+len)
- return; /* 0; */
- if (n < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
- driver_failure_posix(ix, errno);
- return; /* -1; */
- }
- n = 0;
- }
- if (n < pb) {
- driver_enq(ix, lbp+n, pb-n);
- driver_enq(ix, buf, len);
- }
- else {
- n -= pb;
- driver_enq(ix, buf+n, len-n);
- }
- driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
- }
- return; /* 0; */
-}
-
-static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res)
- /* Result: 0 (eof) or -1 (error) */
-{
- int err = errno;
-
- ASSERT(res <= 0);
- (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0);
- clear_fd_data(ready_fd);
-
- if (driver_data[ready_fd].blocking && FDBLOCK) {
- driver_pdl_lock(driver_data[ready_fd].blocking->pdl);
- if (driver_sizeq(driver_data[ready_fd].port_num) > 0) {
- driver_pdl_unlock(driver_data[ready_fd].blocking->pdl);
- /* We have stuff in the output queue, so we just
- set the state to terminating and wait for fd_async_ready
- to terminate the port */
- if (res == 0)
- driver_data[ready_fd].terminating = 2;
- else
- driver_data[ready_fd].terminating = -err;
- return 0;
- }
- driver_pdl_unlock(driver_data[ready_fd].blocking->pdl);
- }
-
- if (res == 0) {
- if (driver_data[ready_fd].report_exit) {
- CHLD_STAT_LOCK;
-
- if (driver_data[ready_fd].alive) {
- /*
- * We have eof and want to report exit status, but the process
- * hasn't exited yet. When it does report_exit_status() will
- * driver_select() this fd which will make sure that we get
- * back here with driver_data[ready_fd].alive == 0 and
- * driver_data[ready_fd].status set.
- */
- CHLD_STAT_UNLOCK;
- return 0;
- }
- else {
- int status = driver_data[ready_fd].status;
- CHLD_STAT_UNLOCK;
-
- /* We need not be prepared for stopped/continued processes. */
- if (WIFSIGNALED(status))
- status = 128 + WTERMSIG(status);
- else
- status = WEXITSTATUS(status);
-
- driver_report_exit(driver_data[ready_fd].port_num, status);
- }
- }
- driver_failure_eof(port_num);
- } else {
- driver_failure_posix(port_num, err);
- }
- return 0;
-}
-
-/* fd is the drv_data that is returned from the */
-/* initial start routine */
-/* ready_fd is the descriptor that is ready to read */
-
-static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd)
-{
- int fd = (int)(long)e;
- ErlDrvPort port_num;
- int packet_bytes;
- int res;
- Uint h;
-
- port_num = driver_data[fd].port_num;
- packet_bytes = driver_data[fd].packet_bytes;
-
-
- if (packet_bytes == 0) {
- byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF,
- ERTS_SYS_READ_BUF_SZ);
- res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ);
- if (res < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK))
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res == 0)
- port_inp_failure(port_num, ready_fd, res);
- else
- driver_output(port_num, (char*) read_buf, res);
- erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf);
- }
- else if (fd_data[ready_fd].remain > 0) { /* We try to read the remainder */
- /* space is allocated in buf */
- res = read(ready_fd, fd_data[ready_fd].cpos,
- fd_data[ready_fd].remain);
- if (res < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK))
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res == 0) {
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res == fd_data[ready_fd].remain) { /* we're done */
- driver_output(port_num, fd_data[ready_fd].buf,
- fd_data[ready_fd].sz);
- clear_fd_data(ready_fd);
- }
- else { /* if (res < fd_data[ready_fd].remain) */
- fd_data[ready_fd].cpos += res;
- fd_data[ready_fd].remain -= res;
- }
- }
- else if (fd_data[ready_fd].remain == 0) { /* clean fd */
- byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF,
- ERTS_SYS_READ_BUF_SZ);
- /* We make one read attempt and see what happens */
- res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ);
- if (res < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK))
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res == 0) { /* eof */
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res < packet_bytes - fd_data[ready_fd].psz) {
- memcpy(fd_data[ready_fd].pbuf+fd_data[ready_fd].psz,
- read_buf, res);
- fd_data[ready_fd].psz += res;
- }
- else { /* if (res >= packet_bytes) */
- unsigned char* cpos = read_buf;
- int bytes_left = res;
-
- while (1) {
- int psz = fd_data[ready_fd].psz;
- char* pbp = fd_data[ready_fd].pbuf + psz;
-
- while(bytes_left && (psz < packet_bytes)) {
- *pbp++ = *cpos++;
- bytes_left--;
- psz++;
- }
-
- if (psz < packet_bytes) {
- fd_data[ready_fd].psz = psz;
- break;
- }
- fd_data[ready_fd].psz = 0;
-
- switch (packet_bytes) {
- case 1: h = get_int8(fd_data[ready_fd].pbuf); break;
- case 2: h = get_int16(fd_data[ready_fd].pbuf); break;
- case 4: h = get_int32(fd_data[ready_fd].pbuf); break;
- default: ASSERT(0); return; /* -1; */
- }
-
- if (h <= (bytes_left)) {
- driver_output(port_num, (char*) cpos, h);
- cpos += h;
- bytes_left -= h;
- continue;
- }
- else { /* The last message we got was split */
- char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h);
- if (!buf) {
- errno = ENOMEM;
- port_inp_failure(port_num, ready_fd, -1);
- }
- else {
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, h);
- sys_memcpy(buf, cpos, bytes_left);
- fd_data[ready_fd].buf = buf;
- fd_data[ready_fd].sz = h;
- fd_data[ready_fd].remain = h - bytes_left;
- fd_data[ready_fd].cpos = buf + bytes_left;
- }
- break;
- }
- }
- }
- erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf);
- }
-}
-
-
-/* fd is the drv_data that is returned from the */
-/* initial start routine */
-/* ready_fd is the descriptor that is ready to read */
-
-static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd)
-{
- int fd = (int)(long)e;
- ErlDrvPort ix = driver_data[fd].port_num;
- int n;
- struct iovec* iv;
- int vsize;
-
-
- if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) {
- driver_select(ix, ready_fd, ERL_DRV_WRITE, 0);
- if (driver_data[fd].terminating)
- driver_failure_atom(driver_data[fd].port_num,"normal");
- return; /* 0; */
- }
- vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize;
- if ((n = writev(ready_fd, iv, vsize)) > 0) {
- if (driver_deq(ix, n) == 0)
- set_busy_port(ix, 0);
- }
- else if (n < 0) {
- if (errno == ERRNO_BLOCK || errno == EINTR)
- return; /* 0; */
- else {
- int res = errno;
- driver_select(ix, ready_fd, ERL_DRV_WRITE, 0);
- driver_failure_posix(ix, res);
- return; /* -1; */
- }
- }
- return; /* 0; */
-}
-
-static void stop_select(ErlDrvEvent fd, void* _)
-{
- close((int)fd);
-}
-
-#if FDBLOCK
-
-static void
-fd_async(void *async_data)
-{
- int res;
- struct driver_data *dd = (struct driver_data*)async_data;
- SysIOVec *iov0;
- SysIOVec *iov;
- int iovlen;
- int err = 0;
- /* much of this code is stolen from efile_drv:invoke_writev */
- driver_pdl_lock(dd->blocking->pdl);
- iov0 = driver_peekq(dd->port_num, &iovlen);
- iovlen = iovlen < MAXIOV ? iovlen : MAXIOV;
- iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF,
- sizeof(SysIOVec)*iovlen);
- if (!iov) {
- res = -1;
- err = ENOMEM;
- driver_pdl_unlock(dd->blocking->pdl);
- } else {
- memcpy(iov,iov0,iovlen*sizeof(SysIOVec));
- driver_pdl_unlock(dd->blocking->pdl);
-
- do {
- res = writev(dd->ofd, iov, iovlen);
- } while (res < 0 && errno == EINTR);
- if (res < 0)
- err = errno;
-
- erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov);
- }
- dd->blocking->res = res;
- dd->blocking->err = err;
-}
-
-void fd_ready_async(ErlDrvData drv_data,
- ErlDrvThreadData thread_data) {
- struct driver_data *dd = (struct driver_data *)thread_data;
- ErlDrvPort port_num = dd->port_num;
-
- ASSERT(dd->blocking);
- ASSERT(dd == (driver_data + (int)(long)drv_data));
-
- if (dd->blocking->res > 0) {
- driver_pdl_lock(dd->blocking->pdl);
- if (driver_deq(port_num, dd->blocking->res) == 0) {
- driver_pdl_unlock(dd->blocking->pdl);
- set_busy_port(port_num, 0);
- if (dd->terminating) {
- /* The port is has been ordered to terminate
- from either fd_flush or port_inp_failure */
- if (dd->terminating == 1)
- driver_failure_atom(port_num, "normal");
- else if (dd->terminating == 2)
- driver_failure_eof(port_num);
- else if (dd->terminating < 0)
- driver_failure_posix(port_num, -dd->terminating);
- return; /* -1; */
- }
- } else {
- driver_pdl_unlock(dd->blocking->pdl);
- /* still data left to write in queue */
- driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL);
- return /* 0; */;
- }
- } else if (dd->blocking->res < 0) {
- if (dd->blocking->err == ERRNO_BLOCK) {
- set_busy_port(port_num, 1);
- /* still data left to write in queue */
- driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL);
- } else
- driver_failure_posix(port_num, dd->blocking->err);
- return; /* -1; */
- }
- return; /* 0; */
-}
-
-#endif
-
void erts_do_break_handling(void)
{
struct termios temp_mode;
@@ -2738,10 +1011,6 @@ erts_sys_unsetenv(char *key)
void
sys_init_io(void)
{
- fd_data = (struct fd_data *)
- erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data));
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
- max_files * sizeof(struct fd_data));
}
#if (0) /* unused? */
@@ -2935,179 +1204,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
@@ -3116,13 +1212,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();
}
@@ -3150,10 +1241,6 @@ smp_sig_notify(char c)
static void *
signal_dispatcher_thread_func(void *unused)
{
-#if !CHLDWTHR
- int initialized = 0;
- int notify_check_children = 0;
-#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_set_thread_name("signal_dispatcher");
#endif
@@ -3191,19 +1278,7 @@ signal_dispatcher_thread_func(void *unused)
*/
switch (buf[i]) {
case 0: /* Emulator initialized */
-#if !CHLDWTHR
- initialized = 1;
- if (!notify_check_children)
-#endif
- break;
-#if !CHLDWTHR
- case 'C': /* SIGCHLD */
- if (initialized)
- erts_smp_notify_check_children_needed();
- else
- notify_check_children = 1;
- break;
-#endif
+ break;
case 'I': /* SIGINT */
break_requested();
break;
diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c
new file mode 100644
index 0000000000..2a7cd91265
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_drivers.c
@@ -0,0 +1,1862 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef ISC32
+#define _POSIX_SOURCE
+#define _XOPEN_SOURCE
+#endif
+
+#include <sys/times.h> /* ! */
+#include <time.h>
+#include <signal.h>
+#include <sys/wait.h>
+#include <sys/uio.h>
+#include <termios.h>
+#include <ctype.h>
+#include <sys/utsname.h>
+#include <sys/select.h>
+#include <arpa/inet.h>
+
+#ifdef ISC32
+#include <sys/bsdtypes.h>
+#endif
+
+#include <termios.h>
+#ifdef HAVE_FCNTL_H
+#include <fcntl.h>
+#endif
+#ifdef HAVE_SYS_IOCTL_H
+#include <sys/ioctl.h>
+#endif
+
+#define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */
+#include "sys.h"
+
+#ifdef USE_THREADS
+#include "erl_threads.h"
+#endif
+
+extern char **environ;
+extern erts_smp_rwmtx_t environ_rwmtx;
+
+extern erts_smp_atomic_t sys_misc_mem_sz;
+
+static Eterm forker_port;
+
+#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O
+ * vector sock_sendv().
+ */
+/*
+ * Don't need global.h, but erl_cpu_topology.h won't compile otherwise
+ */
+#include "global.h"
+#include "erl_cpu_topology.h"
+
+#include "erl_sys_driver.h"
+#include "sys_uds.h"
+
+#include "erl_child_setup.h"
+
+#if defined IOV_MAX
+#define MAXIOV IOV_MAX
+#elif defined UIO_MAXIOV
+#define MAXIOV UIO_MAXIOV
+#else
+#define MAXIOV 16
+#endif
+
+#ifdef USE_THREADS
+# define FDBLOCK 1
+#else
+# define FDBLOCK 0
+#endif
+
+/* Used by the fd driver iff the fd could not be set to non-blocking */
+typedef struct ErtsSysBlocking_ {
+ ErlDrvPDL pdl;
+ int res;
+ int err;
+ unsigned int pkey;
+} ErtsSysBlocking;
+
+typedef struct fd_data {
+ int fd;
+ char pbuf[4]; /* hold partial packet bytes */
+ int psz; /* size of pbuf */
+ char *buf;
+ char *cpos;
+ int sz;
+ int remain; /* for input on fd */
+} ErtsSysFdData;
+
+typedef struct driver_data {
+ ErlDrvPort port_num;
+ ErtsSysFdData *ofd;
+ ErtsSysFdData *ifd;
+ int packet_bytes;
+ int pid;
+ int alive;
+ int status;
+ int terminating;
+ ErtsSysBlocking *blocking;
+} ErtsSysDriverData;
+
+#define DIR_SEPARATOR_CHAR '/'
+
+#if defined(__ANDROID__)
+#define SHELL "/system/bin/sh"
+#else
+#define SHELL "/bin/sh"
+#endif /* __ANDROID__ */
+
+#if defined(DEBUG)
+#define ERL_BUILD_TYPE_MARKER ".debug"
+#elif defined(PURIFY)
+#define ERL_BUILD_TYPE_MARKER ".purify"
+#elif defined(QUANTIFY)
+#define ERL_BUILD_TYPE_MARKER ".quantify"
+#elif defined(PURECOV)
+#define ERL_BUILD_TYPE_MARKER ".purecov"
+#elif defined(VALGRIND)
+#define ERL_BUILD_TYPE_MARKER ".valgrind"
+#else /* opt */
+#define ERL_BUILD_TYPE_MARKER
+#endif
+
+#ifdef DEBUG
+#define close(fd) do { int res = close(fd); ASSERT(res > -1); } while(0)
+#endif
+
+#define CHILD_SETUP_PROG_NAME "erl_child_setup" ERL_BUILD_TYPE_MARKER
+
+// #define HARD_DEBUG
+#ifdef HARD_DEBUG
+#define driver_select(port_num, fd, flags, onoff) \
+ do { \
+ if (((flags) & ERL_DRV_READ) && onoff) \
+ fprintf(stderr,"%010d %p: read select %d\r\n", __LINE__, port_num, (int)fd); \
+ if (((flags) & ERL_DRV_WRITE) && onoff) \
+ fprintf(stderr,"%010d %p: writ select %d\r\n", __LINE__, port_num, (int)fd); \
+ if (((flags) & ERL_DRV_READ) && !onoff) \
+ fprintf(stderr,"%010d %p: read unsele %d\r\n", __LINE__, port_num, (int)fd); \
+ if (((flags) & ERL_DRV_WRITE) && !onoff) \
+ fprintf(stderr,"%010d %p: writ unsele %d\r\n", __LINE__, port_num, (int)fd); \
+ driver_select_nkp(port_num, fd, flags, onoff); \
+ } while(0)
+#endif
+
+/*
+ * Decreasing the size of it below 16384 is not allowed.
+ */
+
+#define ERTS_SYS_READ_BUF_SZ (64*1024)
+
+/* I. Initialization */
+
+void
+erl_sys_late_init(void)
+{
+ SysDriverOpts opts;
+#ifdef ERTS_SMP
+ Port *port;
+#endif
+
+ sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */
+
+ opts.packet_bytes = 0;
+ opts.use_stdio = 1;
+ opts.redir_stderr = 0;
+ opts.read_write = 0;
+ opts.hide_window = 0;
+ opts.wd = NULL;
+ opts.envir = NULL;
+ opts.exit_status = 0;
+ opts.overlapped_io = 0;
+ opts.spawn_type = ERTS_SPAWN_ANY;
+ opts.argv = NULL;
+ opts.parallelism = erts_port_parallelism;
+
+#ifdef ERTS_SMP
+ port =
+#endif
+ erts_open_driver(&forker_driver, make_internal_pid(0), "forker", &opts, NULL, NULL);
+#ifdef ERTS_SMP
+ erts_mtx_unlock(port->lock);
+#endif
+}
+
+/* II. Prototypes */
+
+/* II.I Spawn prototypes */
+static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*);
+static ErlDrvSSizeT spawn_control(ErlDrvData, unsigned int, char *,
+ ErlDrvSizeT, char **, ErlDrvSizeT);
+
+/* II.II Vanilla prototypes */
+static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*);
+
+
+/* II.III FD prototypes */
+static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*);
+#if FDBLOCK
+static void fd_async(void *);
+static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data);
+#endif
+static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT,
+ char **, ErlDrvSizeT);
+static void fd_stop(ErlDrvData);
+static void fd_flush(ErlDrvData);
+
+/* II.IV Common prototypes */
+static void stop(ErlDrvData);
+static void ready_input(ErlDrvData, ErlDrvEvent);
+static void ready_output(ErlDrvData, ErlDrvEvent);
+static void output(ErlDrvData, char*, ErlDrvSizeT);
+static void outputv(ErlDrvData, ErlIOVec*);
+static void stop_select(ErlDrvEvent, void*);
+
+/* II.V Forker prototypes */
+static ErlDrvData forker_start(ErlDrvPort, char*, SysDriverOpts*);
+static void forker_stop(ErlDrvData);
+static void forker_ready_input(ErlDrvData, ErlDrvEvent);
+static void forker_ready_output(ErlDrvData, ErlDrvEvent);
+static ErlDrvSSizeT forker_control(ErlDrvData, unsigned int, char *,
+ ErlDrvSizeT, char **, ErlDrvSizeT);
+
+/* III Driver entries */
+
+/* III.I The spawn driver */
+struct erl_drv_entry spawn_driver_entry = {
+ NULL,
+ spawn_start,
+ stop,
+ output,
+ ready_input,
+ ready_output,
+ "spawn",
+ NULL,
+ NULL,
+ spawn_control,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ ERL_DRV_FLAG_USE_PORT_LOCKING | ERL_DRV_FLAG_USE_INIT_ACK,
+ NULL, NULL,
+ stop_select
+};
+
+/* III.II The fd driver */
+struct erl_drv_entry fd_driver_entry = {
+ NULL,
+ fd_start,
+ fd_stop,
+ output,
+ ready_input,
+ ready_output,
+ "fd",
+ NULL,
+ NULL,
+ fd_control,
+ NULL,
+ outputv,
+#if FDBLOCK
+ fd_ready_async, /* ready_async */
+#else
+ NULL,
+#endif
+ fd_flush, /* flush */
+ NULL, /* call */
+ NULL, /* event */
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0, /* ERL_DRV_FLAGs */
+ NULL, /* handle2 */
+ NULL, /* process_exit */
+ stop_select
+};
+
+/* III.III The vanilla driver */
+struct erl_drv_entry vanilla_driver_entry = {
+ NULL,
+ vanilla_start,
+ stop,
+ output,
+ ready_input,
+ ready_output,
+ "vanilla",
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL, /* flush */
+ NULL, /* call */
+ NULL, /* event */
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0, /* ERL_DRV_FLAGs */
+ NULL, /* handle2 */
+ NULL, /* process_exit */
+ stop_select
+};
+
+/* III.III The forker driver */
+struct erl_drv_entry forker_driver_entry = {
+ NULL,
+ forker_start,
+ forker_stop,
+ NULL,
+ forker_ready_input,
+ forker_ready_output,
+ "spawn_forker",
+ NULL,
+ NULL,
+ forker_control,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0,
+ NULL, NULL,
+ stop_select
+};
+
+/* Untility functions */
+
+static int set_blocking_data(ErtsSysDriverData *dd) {
+
+ dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking));
+
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking));
+
+ dd->blocking->pdl = driver_pdl_create(dd->port_num);
+ dd->blocking->res = 0;
+ dd->blocking->err = 0;
+ dd->blocking->pkey = driver_async_port_key(dd->port_num);
+
+ return 1;
+}
+
+static void init_fd_data(ErtsSysFdData *fd_data, int fd)
+{
+ fd_data->fd = fd;
+ fd_data->buf = NULL;
+ fd_data->cpos = NULL;
+ fd_data->remain = 0;
+ fd_data->sz = 0;
+ fd_data->psz = 0;
+}
+
+static ErtsSysDriverData *
+create_driver_data(ErlDrvPort port_num,
+ int ifd,
+ int ofd,
+ int packet_bytes,
+ int read_write,
+ int exit_status,
+ int pid,
+ int is_blocking)
+{
+ Port *prt;
+ ErtsSysDriverData *driver_data;
+ char *data;
+ int size = sizeof(ErtsSysDriverData);
+
+ if (read_write & DO_READ)
+ size += sizeof(ErtsSysFdData);
+
+ if ((read_write & DO_WRITE) &&
+ ((ifd != ofd || ofd == -1) || !(read_write & DO_READ)))
+ size += sizeof(ErtsSysFdData);
+
+ data = erts_alloc(ERTS_ALC_T_DRV_TAB,size);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, size);
+
+ driver_data = (ErtsSysDriverData*)data;
+ data += sizeof(*driver_data);
+
+ prt = erts_drvport2port(port_num);
+ if (prt != ERTS_INVALID_ERL_DRV_PORT)
+ prt->os_pid = pid;
+
+ driver_data->packet_bytes = packet_bytes;
+ driver_data->port_num = port_num;
+ driver_data->pid = pid;
+ driver_data->alive = exit_status ? 1 : 0;
+ driver_data->status = 0;
+ driver_data->terminating = 0;
+ driver_data->blocking = NULL;
+
+ if (read_write & DO_READ) {
+ driver_data->ifd = (ErtsSysFdData*)data;
+ data += sizeof(*driver_data->ifd);
+ init_fd_data(driver_data->ifd, ifd);
+ driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1);
+ } else {
+ driver_data->ifd = NULL;
+ }
+
+ if (read_write & DO_WRITE) {
+ if (ofd != -1 && ifd == ofd && read_write & DO_READ) {
+ /* This is for when ifd and ofd are the same fd */
+ driver_data->ofd = driver_data->ifd;
+ } else {
+ driver_data->ofd = (ErtsSysFdData*)data;
+ data += sizeof(*driver_data->ofd);
+ init_fd_data(driver_data->ofd, ofd);
+ }
+ if (is_blocking && FDBLOCK)
+ if (!set_blocking_data(driver_data)) {
+ erts_free(ERTS_ALC_T_DRV_TAB, driver_data);
+ return NULL;
+ }
+ } else {
+ driver_data->ofd = NULL;
+ }
+
+ return driver_data;
+}
+
+/* Spawn driver */
+
+static void close_pipes(int ifd[2], int ofd[2])
+{
+ close(ifd[0]);
+ close(ifd[1]);
+ close(ofd[0]);
+ close(ofd[1]);
+}
+
+static char **build_unix_environment(char *block)
+{
+ int i;
+ int j;
+ int len;
+ char *cp;
+ char **cpp;
+ char** old_env;
+
+ ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx));
+
+ cp = block;
+ len = 0;
+ while (*cp != '\0') {
+ cp += strlen(cp) + 1;
+ len++;
+ }
+ old_env = environ;
+ while (*old_env++ != NULL) {
+ len++;
+ }
+
+ cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT,
+ sizeof(char *) * (len+1));
+ if (cpp == NULL) {
+ return NULL;
+ }
+
+ cp = block;
+ len = 0;
+ while (*cp != '\0') {
+ cpp[len] = cp;
+ cp += strlen(cp) + 1;
+ len++;
+ }
+
+ i = len;
+ for (old_env = environ; *old_env; old_env++) {
+ char* old = *old_env;
+
+ for (j = 0; j < len; j++) {
+ char *s, *t;
+
+ /* check if cpp[j] equals old
+ before the = sign,
+ i.e.
+ "TMPDIR=/tmp/" */
+ s = cpp[j];
+ t = old;
+ while (*s == *t && *s != '=') {
+ s++, t++;
+ }
+ if (*s == '=' && *t == '=') {
+ break;
+ }
+ }
+
+ if (j == len) { /* New version not found */
+ cpp[len++] = old;
+ }
+ }
+
+ for (j = 0; j < i; ) {
+ size_t last = strlen(cpp[j])-1;
+ if (cpp[j][last] == '=' && strchr(cpp[j], '=') == cpp[j]+last) {
+ cpp[j] = cpp[--len];
+ if (len < i) {
+ i--;
+ } else {
+ j++;
+ }
+ }
+ else {
+ j++;
+ }
+ }
+
+ cpp[len] = NULL;
+ return cpp;
+}
+
+static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
+ SysDriverOpts* opts)
+{
+#define CMD_LINE_PREFIX_STR "exec "
+#define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1)
+
+ int len;
+ char **new_environ;
+ ErtsSysDriverData *dd;
+ char *cmd_line;
+ char wd_buff[MAXPATHLEN+1];
+ char *wd;
+ int ifd[2], ofd[2], stderrfd;
+
+ if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO;
+ errno = EMFILE; /* default for next three conditions */
+ if (ifd[0] >= sys_max_files() || pipe(ofd) < 0) {
+ close(ifd[0]);
+ close(ifd[1]);
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ if (ofd[1] >= sys_max_files()) {
+ close_pipes(ifd, ofd);
+ errno = EMFILE;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+
+ SET_NONBLOCKING(ifd[0]);
+ SET_NONBLOCKING(ofd[1]);
+
+ stderrfd = opts->redir_stderr ? ifd[1] : dup(2);
+
+ if (stderrfd >= sys_max_files() || stderrfd < 0) {
+ close_pipes(ifd, ofd);
+ if (stderrfd > -1)
+ close(stderrfd);
+ return ERL_DRV_ERROR_ERRNO;
+ }
+
+ if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
+ /* started with spawn_executable, not with spawn */
+ len = strlen(name);
+ cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1);
+ if (!cmd_line) {
+ close_pipes(ifd, ofd);
+ errno = ENOMEM;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ memcpy((void *) cmd_line,(void *) name, len);
+ cmd_line[len] = '\0';
+ len = len + 1;
+ if (access(cmd_line,X_OK) != 0) {
+ int save_errno = errno;
+ erts_free(ERTS_ALC_T_TMP, cmd_line);
+ close_pipes(ifd, ofd);
+ errno = save_errno;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ } else {
+ /* make the string suitable for giving to "sh" */
+ len = strlen(name);
+ cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP,
+ CMD_LINE_PREFIX_STR_SZ + len + 1);
+ if (!cmd_line) {
+ close_pipes(ifd, ofd);
+ errno = ENOMEM;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ memcpy((void *) cmd_line,
+ (void *) CMD_LINE_PREFIX_STR,
+ CMD_LINE_PREFIX_STR_SZ);
+ memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len);
+ cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0';
+ len = CMD_LINE_PREFIX_STR_SZ + len + 1;
+ }
+
+ erts_smp_rwmtx_rlock(&environ_rwmtx);
+
+ if (opts->envir == NULL) {
+ new_environ = environ;
+ } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) {
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+ close_pipes(ifd, ofd);
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+ errno = ENOMEM;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+
+ if (opts->wd == NULL) {
+ if ((wd = getcwd(wd_buff, MAXPATHLEN+1)) == NULL) {
+ /* on some OSs this call opens a fd in the
+ background which means that this can
+ return EMFILE */
+ int err = errno;
+ close_pipes(ifd, ofd);
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+ if (new_environ != environ)
+ erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+ errno = err;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ } else {
+ wd = opts->wd;
+ }
+
+ {
+ struct iovec *io_vector;
+ int iov_len = 5;
+ char nullbuff[] = "\0";
+ int j, i = 0, res;
+ Sint32 buffsz = 0, env_len = 0, argv_len = 0,
+ flags = (opts->use_stdio ? FORKER_FLAG_USE_STDIO : 0)
+ | (opts->exit_status ? FORKER_FLAG_EXIT_STATUS : 0)
+ | (opts->read_write & DO_READ ? FORKER_FLAG_DO_READ : 0)
+ | (opts->read_write & DO_WRITE ? FORKER_FLAG_DO_WRITE : 0);
+
+ /* count number of elements in environment */
+ while(new_environ[env_len] != NULL)
+ env_len++;
+ iov_len += 1 + env_len; /* num envs including size int */
+
+ /* count number of element in argument list */
+ if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
+ if (opts->argv != NULL) {
+ while(opts->argv[argv_len] != NULL)
+ argv_len++;
+ } else {
+ argv_len++;
+ }
+ iov_len += 1 + argv_len; /* num argvs including size int */
+ }
+
+ io_vector = erts_alloc_fnf(ERTS_ALC_T_TMP, sizeof(struct iovec) * iov_len);
+
+ if (!io_vector) {
+ close_pipes(ifd, ofd);
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+ if (new_environ != environ)
+ erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
+ errno = ENOMEM;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+
+ io_vector[i].iov_base = (void*)&buffsz;
+ io_vector[i++].iov_len = sizeof(buffsz);
+
+ io_vector[i].iov_base = (void*)&flags;
+ flags = htonl(flags);
+ io_vector[i++].iov_len = sizeof(flags);
+ buffsz += sizeof(flags);
+
+ io_vector[i].iov_base = cmd_line;
+ io_vector[i++].iov_len = len;
+ buffsz += len;
+
+ io_vector[i].iov_base = wd;
+ io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1;
+ buffsz += io_vector[i++].iov_len;
+
+ io_vector[i].iov_base = nullbuff;
+ io_vector[i++].iov_len = 1;
+ buffsz += io_vector[i-1].iov_len;
+
+ io_vector[i].iov_base = (void*)&env_len;
+ env_len = htonl(env_len);
+ io_vector[i++].iov_len = sizeof(env_len);
+ buffsz += io_vector[i-1].iov_len;
+
+ for (j = 0; new_environ[j] != NULL; j++) {
+ io_vector[i].iov_base = new_environ[j];
+ io_vector[i++].iov_len = strlen(new_environ[j]) + 1;
+ buffsz += io_vector[i-1].iov_len;
+ }
+
+ /* only append arguments if this was a spawn_executable */
+ if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
+
+ io_vector[i].iov_base = (void*)&argv_len;
+ argv_len = htonl(argv_len);
+ io_vector[i++].iov_len = sizeof(argv_len);
+ buffsz += io_vector[i-1].iov_len;
+
+ if (opts->argv) {
+ /* If there are arguments we copy in the references to
+ them into the iov */
+ for (j = 0; opts->argv[j]; j++) {
+ if (opts->argv[j] == erts_default_arg0)
+ io_vector[i].iov_base = cmd_line;
+ else
+ io_vector[i].iov_base = opts->argv[j];
+ io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1;
+ buffsz += io_vector[i++].iov_len;
+ }
+ } else {
+ io_vector[i].iov_base = cmd_line;
+ io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1;
+ buffsz += io_vector[i++].iov_len;
+ }
+ }
+
+ /* we send the request to do the fork */
+ if ((res = writev(ofd[1], io_vector, iov_len > MAXIOV ? MAXIOV : iov_len)) < 0) {
+ if (errno == ERRNO_BLOCK) {
+ res = 0;
+ } else {
+ int err = errno;
+ close_pipes(ifd, ofd);
+ erts_free(ERTS_ALC_T_TMP, io_vector);
+ if (new_environ != environ)
+ erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+ errno = err;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ }
+
+ if (res < buffsz) {
+ /* we only wrote part of the command payload. Enqueue the rest. */
+ for (i = 0; i < iov_len; i++) {
+ driver_enq(port_num, io_vector[i].iov_base, io_vector[i].iov_len);
+ }
+ driver_deq(port_num, res);
+ driver_select(port_num, ofd[1], ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ }
+
+ erts_free(ERTS_ALC_T_TMP, io_vector);
+ }
+
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+
+ if (new_environ != environ)
+ erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
+
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+
+ dd = create_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes,
+ DO_WRITE | DO_READ, opts->exit_status,
+ 0, 0);
+
+ {
+ /* send ofd[0] + ifd[1] + stderrfd to forker port */
+ ErtsSysForkerProto *proto =
+ erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA,
+ sizeof(ErtsSysForkerProto));
+ memset(proto, 0, sizeof(ErtsSysForkerProto));
+ proto->action = ErtsSysForkerProtoAction_Start;
+ proto->u.start.fds[0] = ofd[0];
+ proto->u.start.fds[1] = ifd[1];
+ proto->u.start.fds[2] = stderrfd;
+ proto->u.start.port_id = opts->exit_status ? erts_drvport2id(port_num) : THE_NON_VALUE;
+ if (erl_drv_port_control(forker_port, 'S', (char*)proto, sizeof(*proto))) {
+ /* The forker port has been killed, we close both fd's which will
+ make open_port throw an epipe error */
+ close(ofd[0]);
+ close(ifd[1]);
+ }
+ }
+
+ /* we set these fds to negative to mark if
+ they should be closed after the handshake */
+ if (!(opts->read_write & DO_READ))
+ dd->ifd->fd *= -1;
+
+ if (!(opts->read_write & DO_WRITE))
+ dd->ofd->fd *= -1;
+
+ return (ErlDrvData)dd;
+#undef CMD_LINE_PREFIX_STR
+#undef CMD_LINE_PREFIX_STR_SZ
+}
+
+static ErlDrvSSizeT spawn_control(ErlDrvData e, unsigned int cmd, char *buf,
+ ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf;
+
+ ASSERT(len == sizeof(*proto));
+ ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld);
+
+ dd->status = proto->u.sigchld.error_number;
+ dd->alive = -1;
+
+ if (dd->ifd)
+ driver_select(dd->port_num, abs(dd->ifd->fd), ERL_DRV_READ | ERL_DRV_USE, 1);
+
+ if (dd->ofd)
+ driver_select(dd->port_num, abs(dd->ofd->fd), ERL_DRV_WRITE | ERL_DRV_USE, 1);
+
+ return 0;
+}
+
+#define FD_DEF_HEIGHT 24
+#define FD_DEF_WIDTH 80
+/* Control op */
+#define FD_CTRL_OP_GET_WINSIZE 100
+
+static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height)
+{
+#ifdef TIOCGWINSZ
+ struct winsize ws;
+ if (ioctl(fd,TIOCGWINSZ,&ws) == 0) {
+ *width = (Uint32) ws.ws_col;
+ *height = (Uint32) ws.ws_row;
+ return 0;
+ }
+#endif
+ return -1;
+}
+
+static ErlDrvSSizeT fd_control(ErlDrvData drv_data,
+ unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen)
+{
+ int fd = (int)(long)drv_data;
+ char resbuff[2*sizeof(Uint32)];
+ switch (command) {
+ case FD_CTRL_OP_GET_WINSIZE:
+ {
+ Uint32 w,h;
+ if (fd_get_window_size(fd,&w,&h))
+ return 0;
+ memcpy(resbuff,&w,sizeof(Uint32));
+ memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32));
+ }
+ break;
+ default:
+ return 0;
+ }
+ if (rlen < 2*sizeof(Uint32)) {
+ *rbuf = driver_alloc(2*sizeof(Uint32));
+ }
+ memcpy(*rbuf,resbuff,2*sizeof(Uint32));
+ return 2*sizeof(Uint32);
+}
+
+static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
+ SysDriverOpts* opts)
+{
+ int non_blocking = 0;
+
+ if (((opts->read_write & DO_READ) && opts->ifd >= sys_max_files()) ||
+ ((opts->read_write & DO_WRITE) && opts->ofd >= sys_max_files()))
+ return ERL_DRV_ERROR_GENERAL;
+
+ /*
+ * Historical:
+ *
+ * "Note about nonblocking I/O.
+ *
+ * At least on Solaris, setting the write end of a TTY to nonblocking,
+ * will set the input end to nonblocking as well (and vice-versa).
+ * If erl is run in a pipeline like this: cat | erl
+ * the input end of the TTY will be the standard input of cat.
+ * And cat is not prepared to handle nonblocking I/O."
+ *
+ * Actually, the reason for this is not that the tty itself gets set
+ * in non-blocking mode, but that the "input end" (cat's stdin) and
+ * the "output end" (erlang's stdout) are typically the "same" file
+ * descriptor, dup()'ed from a single fd by one of this process'
+ * ancestors.
+ *
+ * The workaround for this problem used to be a rather bad kludge,
+ * interposing an extra process ("internal cat") between erlang's
+ * stdout and the original stdout, allowing erlang to set its stdout
+ * in non-blocking mode without affecting the stdin of the preceding
+ * process in the pipeline - and being a kludge, it caused all kinds
+ * of weird problems.
+ *
+ * So, this is the current logic:
+ *
+ * The only reason to set non-blocking mode on the output fd at all is
+ * if it's something that can cause a write() to block, of course,
+ * i.e. primarily if it points to a tty, socket, pipe, or fifo.
+ *
+ * If we don't set non-blocking mode when we "should" have, and output
+ * becomes blocked, the entire runtime system will be suspended - this
+ * is normally bad of course, and can happen fairly "easily" - e.g. user
+ * hits ^S on tty - but doesn't necessarily happen.
+ *
+ * If we do set non-blocking mode when we "shouldn't" have, the runtime
+ * system will end up seeing EOF on the input fd (due to the preceding
+ * process dying), which typically will cause the entire runtime system
+ * to terminate immediately (due to whatever erlang process is seeing
+ * the EOF taking it as a signal to halt the system). This is *very* bad.
+ *
+ * I.e. we should take a conservative approach, and only set non-
+ * blocking mode when we a) need to, and b) are reasonably certain
+ * that it won't be a problem. And as in the example above, the problem
+ * occurs when input fd and output fd point to different "things".
+ *
+ * However, determining that they are not just the same "type" of
+ * "thing", but actually the same instance of that type of thing, is
+ * unreasonably complex in many/most cases.
+ *
+ * Also, with pipes, sockets, and fifos it's far from obvious that the
+ * user *wants* non-blocking output: If you're running erlang inside
+ * some complex pipeline, you're probably not running a real-time system
+ * that must never stop, but rather *want* it to suspend if the output
+ * channel is "full".
+ *
+ * So, the bottom line: We will only set the output fd non-blocking if
+ * it points to a tty, and either a) the input fd also points to a tty,
+ * or b) we can make sure that setting the output fd non-blocking
+ * doesn't interfere with someone else's input, via a somewhat milder
+ * kludge than the above.
+ *
+ * Also keep in mind that while this code is almost exclusively run as
+ * a result of an erlang open_port({fd,0,1}, ...), that isn't the only
+ * case - it can be called with any old pre-existing file descriptors,
+ * the relations between which (if they're even two) we can only guess
+ * at - still, we try our best...
+ *
+ * Added note OTP 18: Some systems seem to use stdout/stderr to log data
+ * using unix pipes, so we cannot allow the system to block on a write.
+ * Therefore we use an async thread to write the data to fd's that could
+ * not be set to non-blocking. When no async threads are available we
+ * fall back on the old behaviour.
+ *
+ * Also the guarantee about what is delivered to the OS has changed.
+ * Pre 18 the fd driver did no flushing of data before terminating.
+ * Now it does. This is because we want to be able to guarantee that things
+ * such as escripts and friends really have outputted all data before
+ * terminating. This could potentially block the termination of the system
+ * for a very long time, but if the user wants to terminate fast she should
+ * use erlang:halt with flush=false.
+ */
+
+ /* Try to figure out if we can use non-blocking writes */
+ if (opts->read_write & DO_WRITE) {
+
+ /* If we don't have a read end, all bets are off - no non-blocking. */
+ if (opts->read_write & DO_READ) {
+
+ if (isatty(opts->ofd)) { /* output fd is a tty:-) */
+
+ if (isatty(opts->ifd)) { /* input fd is also a tty */
+
+ /* To really do this "right", we should also check that
+ input and output fd point to the *same* tty - but
+ this seems like overkill; ttyname() isn't for free,
+ and this is a very common case - and it's hard to
+ imagine a scenario where setting non-blocking mode
+ here would cause problems - go ahead and do it. */
+
+ non_blocking = 1;
+ SET_NONBLOCKING(opts->ofd);
+
+ } else { /* output fd is a tty, input fd isn't */
+
+ /* This is a "problem case", but also common (see the
+ example above) - i.e. it makes sense to try a bit
+ harder before giving up on non-blocking mode: Try to
+ re-open the tty that the output fd points to, and if
+ successful replace the original one with the "new" fd
+ obtained this way, and set *that* one in non-blocking
+ mode. (Yes, this is a kludge.)
+
+ However, re-opening the tty may fail in a couple of
+ (unusual) cases:
+
+ 1) The name of the tty (or an equivalent one, i.e.
+ same major/minor number) can't be found, because
+ it actually lives somewhere other than /dev (or
+ wherever ttyname() looks for it), and isn't
+ equivalent to any of those that do live in the
+ "standard" place - this should be *very* unusual.
+
+ 2) Permissions on the tty don't allow us to open it -
+ it's perfectly possible to have an fd open to an
+ object whose permissions wouldn't allow us to open
+ it. This is not as unusual as it sounds, one case
+ is if the user has su'ed to someone else (not
+ root) - we have a read/write fd open to the tty
+ (because it has been inherited all the way down
+ here), but we have neither read nor write
+ permission for the tty.
+
+ In these cases, we finally give up, and don't set the
+ output fd in non-blocking mode. */
+
+ char *tty;
+ int nfd;
+
+ if ((tty = ttyname(opts->ofd)) != NULL &&
+ (nfd = open(tty, O_WRONLY)) != -1) {
+ dup2(nfd, opts->ofd);
+ close(nfd);
+ non_blocking = 1;
+ SET_NONBLOCKING(opts->ofd);
+ }
+ }
+ }
+ }
+ }
+ return (ErlDrvData)create_driver_data(port_num, opts->ifd, opts->ofd,
+ opts->packet_bytes,
+ opts->read_write, 0, -1,
+ !non_blocking);
+}
+
+static void clear_fd_data(ErtsSysFdData *fdd)
+{
+ if (fdd->sz > 0) {
+ erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fdd->buf);
+ ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fdd->sz);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fdd->sz);
+ }
+ fdd->buf = NULL;
+ fdd->sz = 0;
+ fdd->remain = 0;
+ fdd->cpos = NULL;
+ fdd->psz = 0;
+}
+
+static void nbio_stop_fd(ErlDrvPort prt, ErtsSysFdData *fdd)
+{
+ driver_select(prt, abs(fdd->fd), DO_READ|DO_WRITE, 0);
+ clear_fd_data(fdd);
+ SET_BLOCKING(abs(fdd->fd));
+
+}
+
+static void fd_stop(ErlDrvData ev) /* Does not close the fds */
+{
+ ErtsSysDriverData* dd = (ErtsSysDriverData*)ev;
+ ErlDrvPort prt = dd->port_num;
+ int sz = sizeof(ErtsSysDriverData);
+
+#if FDBLOCK
+ if (dd->blocking) {
+ erts_free(ERTS_ALC_T_SYS_BLOCKING, dd->blocking);
+ dd->blocking = NULL;
+ sz += sizeof(ErtsSysBlocking);
+ }
+#endif
+
+ if (dd->ifd) {
+ sz += sizeof(ErtsSysFdData);
+ nbio_stop_fd(prt, dd->ifd);
+ }
+ if (dd->ofd && dd->ofd != dd->ifd) {
+ sz += sizeof(ErtsSysFdData);
+ nbio_stop_fd(prt, dd->ofd);
+ }
+
+ erts_free(ERTS_ALC_T_DRV_TAB, dd);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sz);
+}
+
+static void fd_flush(ErlDrvData ev)
+{
+ ErtsSysDriverData* dd = (ErtsSysDriverData*)ev;
+ if (!dd->terminating)
+ dd->terminating = 1;
+}
+
+static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name,
+ SysDriverOpts* opts)
+{
+ int flags, fd;
+ ErlDrvData res;
+
+ flags = (opts->read_write == DO_READ ? O_RDONLY :
+ opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC :
+ O_RDWR|O_CREAT);
+ if ((fd = open(name, flags, 0666)) < 0)
+ return ERL_DRV_ERROR_GENERAL;
+ if (fd >= sys_max_files()) {
+ close(fd);
+ return ERL_DRV_ERROR_GENERAL;
+ }
+ SET_NONBLOCKING(fd);
+
+ res = (ErlDrvData)(long)create_driver_data(port_num, fd, fd,
+ opts->packet_bytes,
+ opts->read_write, 0, -1, 0);
+ return res;
+}
+
+/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */
+/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */
+
+static void stop(ErlDrvData ev)
+{
+ ErtsSysDriverData* dd = (ErtsSysDriverData*)ev;
+ ErlDrvPort prt = dd->port_num;
+
+ if (dd->ifd) {
+ nbio_stop_fd(prt, dd->ifd);
+ driver_select(prt, abs(dd->ifd->fd), ERL_DRV_USE, 0); /* close(ifd); */
+ }
+
+ if (dd->ofd && dd->ofd != dd->ifd) {
+ nbio_stop_fd(prt, dd->ofd);
+ driver_select(prt, abs(dd->ofd->fd), ERL_DRV_USE, 0); /* close(ofd); */
+ }
+
+ erts_free(ERTS_ALC_T_DRV_TAB, dd);
+}
+
+/* used by fd_driver */
+static void outputv(ErlDrvData e, ErlIOVec* ev)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErlDrvPort ix = dd->port_num;
+ int pb = dd->packet_bytes;
+ int ofd = dd->ofd ? dd->ofd->fd : -1;
+ ssize_t n;
+ ErlDrvSizeT sz;
+ char lb[4];
+ char* lbp;
+ ErlDrvSizeT len = ev->size;
+
+ /* (len > ((unsigned long)-1 >> (4-pb)*8)) */
+ /* if (pb >= 0 && (len & (((ErlDrvSizeT)1 << (pb*8))) - 1) != len) {*/
+ if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) {
+ driver_failure_posix(ix, EINVAL);
+ return; /* -1; */
+ }
+ /* Handles 0 <= pb <= 4 only */
+ put_int32((Uint32) len, lb);
+ lbp = lb + (4-pb);
+
+ ev->iov[0].iov_base = lbp;
+ ev->iov[0].iov_len = pb;
+ ev->size += pb;
+
+ if (dd->blocking && FDBLOCK)
+ driver_pdl_lock(dd->blocking->pdl);
+
+ if ((sz = driver_sizeq(ix)) > 0) {
+ driver_enqv(ix, ev, 0);
+
+ if (dd->blocking && FDBLOCK)
+ driver_pdl_unlock(dd->blocking->pdl);
+
+ if (sz + ev->size >= (1 << 13))
+ set_busy_port(ix, 1);
+ }
+ else if (!dd->blocking || !FDBLOCK) {
+ /* We try to write directly if the fd in non-blocking */
+ int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize;
+
+ n = writev(ofd, (const void *) (ev->iov), vsize);
+ if (n == ev->size)
+ return; /* 0;*/
+ if (n < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
+ driver_failure_posix(ix, errno);
+ return; /* -1;*/
+ }
+ n = 0;
+ }
+ driver_enqv(ix, ev, n); /* n is the skip value */
+ driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ }
+#if FDBLOCK
+ else {
+ if (ev->size != 0) {
+ driver_enqv(ix, ev, 0);
+ driver_pdl_unlock(dd->blocking->pdl);
+ driver_async(ix, &dd->blocking->pkey,
+ fd_async, dd, NULL);
+ } else {
+ driver_pdl_unlock(dd->blocking->pdl);
+ }
+ }
+#endif
+ /* return 0;*/
+}
+
+/* Used by spawn_driver and vanilla driver */
+static void output(ErlDrvData e, char* buf, ErlDrvSizeT len)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErlDrvPort ix = dd->port_num;
+ int pb = dd->packet_bytes;
+ int ofd = dd->ofd ? dd->ofd->fd : -1;
+ ssize_t n;
+ ErlDrvSizeT sz;
+ char lb[4];
+ char* lbp;
+ struct iovec iv[2];
+
+ /* (len > ((unsigned long)-1 >> (4-pb)*8)) */
+ if (((pb == 2) && (len > 0xffff))
+ || (pb == 1 && len > 0xff)
+ || dd->pid == 0 /* Attempt at output before port is ready */) {
+ driver_failure_posix(ix, EINVAL);
+ return; /* -1; */
+ }
+ put_int32(len, lb);
+ lbp = lb + (4-pb);
+
+ if ((sz = driver_sizeq(ix)) > 0) {
+ driver_enq(ix, lbp, pb);
+ driver_enq(ix, buf, len);
+ if (sz + len + pb >= (1 << 13))
+ set_busy_port(ix, 1);
+ }
+ else {
+ iv[0].iov_base = lbp;
+ iv[0].iov_len = pb; /* should work for pb=0 */
+ iv[1].iov_base = buf;
+ iv[1].iov_len = len;
+ n = writev(ofd, iv, 2);
+ if (n == pb+len)
+ return; /* 0; */
+ if (n < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
+ driver_failure_posix(ix, errno);
+ return; /* -1; */
+ }
+ n = 0;
+ }
+ if (n < pb) {
+ driver_enq(ix, lbp+n, pb-n);
+ driver_enq(ix, buf, len);
+ }
+ else {
+ n -= pb;
+ driver_enq(ix, buf+n, len-n);
+ }
+ driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ }
+ return; /* 0; */
+}
+
+static int port_inp_failure(ErtsSysDriverData *dd, int res)
+ /* Result: 0 (eof) or -1 (error) */
+{
+ int err = errno;
+
+ ASSERT(res <= 0);
+ if (dd->ifd) {
+ driver_select(dd->port_num, dd->ifd->fd, ERL_DRV_READ|ERL_DRV_WRITE, 0);
+ clear_fd_data(dd->ifd);
+ }
+
+ if (dd->blocking && FDBLOCK) {
+ driver_pdl_lock(dd->blocking->pdl);
+ if (driver_sizeq(dd->port_num) > 0) {
+ driver_pdl_unlock(dd->blocking->pdl);
+ /* We have stuff in the output queue, so we just
+ set the state to terminating and wait for fd_async_ready
+ to terminate the port */
+ if (res == 0)
+ dd->terminating = 2;
+ else
+ dd->terminating = -err;
+ return 0;
+ }
+ driver_pdl_unlock(dd->blocking->pdl);
+ }
+
+ if (res == 0) {
+ if (dd->alive == 1) {
+ /*
+ * We have eof and want to report exit status, but the process
+ * hasn't exited yet. When it does ready_input will
+ * driver_select() this fd which will make sure that we get
+ * back here with dd->alive == -1 and dd->status set.
+ */
+ return 0;
+ }
+ else if (dd->alive == -1) {
+ int status = dd->status;
+
+ /* We need not be prepared for stopped/continued processes. */
+ if (WIFSIGNALED(status))
+ status = 128 + WTERMSIG(status);
+ else
+ status = WEXITSTATUS(status);
+ driver_report_exit(dd->port_num, status);
+ }
+ driver_failure_eof(dd->port_num);
+ } else if (dd->ifd) {
+ erl_drv_init_ack(dd->port_num, ERL_DRV_ERROR_ERRNO);
+ } else {
+ driver_failure_posix(dd->port_num, err);
+ }
+ return 0;
+}
+
+/* fd is the drv_data that is returned from the */
+/* initial start routine */
+/* ready_fd is the descriptor that is ready to read */
+
+static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErlDrvPort port_num;
+ int packet_bytes;
+ int res;
+ Uint h;
+
+ port_num = dd->port_num;
+ packet_bytes = dd->packet_bytes;
+
+ ASSERT(abs(dd->ifd->fd) == ready_fd);
+
+ if (dd->pid == 0) {
+ /* the pid is sent from erl_child_setup. spawn driver only. */
+ ErtsSysForkerProto proto;
+ int res;
+
+ if((res = read(ready_fd, &proto, sizeof(proto))) <= 0) {
+ /* hmm, child setup seems to have closed the pipe too early...
+ we close the port as there is not much else we can do */
+ if (res < 0 && errno == ERRNO_BLOCK)
+ return;
+ driver_select(port_num, ready_fd, ERL_DRV_READ, 0);
+ if (res == 0)
+ errno = EPIPE;
+ port_inp_failure(dd, -1);
+ return;
+ }
+
+ ASSERT(proto.action == ErtsSysForkerProtoAction_Go);
+ dd->pid = proto.u.go.os_pid;
+
+ if (dd->pid == -1) {
+ /* Setup failed! The only reason why this should happen is if
+ the fork fails. */
+ errno = proto.u.go.error_number;
+ port_inp_failure(dd, -1);
+ return;
+ }
+
+ proto.action = ErtsSysForkerProtoAction_Ack;
+
+ if (driver_sizeq(port_num) > 0) {
+ driver_enq(port_num, (char*)&proto, sizeof(proto));
+ } else {
+ if (write(abs(dd->ofd->fd), &proto, sizeof(proto)) < 0)
+ if (errno == ERRNO_BLOCK || errno == EINTR)
+ driver_enq(port_num, (char*)&proto, sizeof(proto));
+ /* do nothing on failure here. If the ofd is broken, then
+ the ifd will probably also be broken and trigger
+ a port_inp_failure */
+ }
+
+ if (dd->ifd->fd < 0) {
+ driver_select(port_num, abs(dd->ifd->fd), ERL_DRV_READ|ERL_DRV_USE, 0);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData));
+ dd->ifd = NULL;
+ }
+
+ if (dd->ofd->fd < 0 || driver_sizeq(port_num) > 0)
+ /* we select in order to close fd or write to queue,
+ child setup will close this fd if fd < 0 */
+ driver_select(port_num, abs(dd->ofd->fd), ERL_DRV_WRITE|ERL_DRV_USE, 1);
+
+ erl_drv_set_os_pid(port_num, dd->pid);
+ erl_drv_init_ack(port_num, e);
+ return;
+ }
+
+ if (packet_bytes == 0) {
+ byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF,
+ ERTS_SYS_READ_BUF_SZ);
+ res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ);
+ if (res < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK))
+ port_inp_failure(dd, res);
+ }
+ else if (res == 0)
+ port_inp_failure(dd, res);
+ else
+ driver_output(port_num, (char*) read_buf, res);
+ erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf);
+ }
+ else if (dd->ifd->remain > 0) { /* We try to read the remainder */
+ /* space is allocated in buf */
+ res = read(ready_fd, dd->ifd->cpos,
+ dd->ifd->remain);
+ if (res < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK))
+ port_inp_failure(dd, res);
+ }
+ else if (res == 0) {
+ port_inp_failure(dd, res);
+ }
+ else if (res == dd->ifd->remain) { /* we're done */
+ driver_output(port_num, dd->ifd->buf,
+ dd->ifd->sz);
+ clear_fd_data(dd->ifd);
+ }
+ else { /* if (res < dd->ifd->remain) */
+ dd->ifd->cpos += res;
+ dd->ifd->remain -= res;
+ }
+ }
+ else if (dd->ifd->remain == 0) { /* clean fd */
+ byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF,
+ ERTS_SYS_READ_BUF_SZ);
+ /* We make one read attempt and see what happens */
+ res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ);
+ if (res < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK))
+ port_inp_failure(dd, res);
+ }
+ else if (res == 0) { /* eof */
+ port_inp_failure(dd, res);
+ }
+ else if (res < packet_bytes - dd->ifd->psz) {
+ memcpy(dd->ifd->pbuf+dd->ifd->psz,
+ read_buf, res);
+ dd->ifd->psz += res;
+ }
+ else { /* if (res >= packet_bytes) */
+ unsigned char* cpos = read_buf;
+ int bytes_left = res;
+
+ while (1) {
+ int psz = dd->ifd->psz;
+ char* pbp = dd->ifd->pbuf + psz;
+
+ while(bytes_left && (psz < packet_bytes)) {
+ *pbp++ = *cpos++;
+ bytes_left--;
+ psz++;
+ }
+
+ if (psz < packet_bytes) {
+ dd->ifd->psz = psz;
+ break;
+ }
+ dd->ifd->psz = 0;
+
+ switch (packet_bytes) {
+ case 1: h = get_int8(dd->ifd->pbuf); break;
+ case 2: h = get_int16(dd->ifd->pbuf); break;
+ case 4: h = get_int32(dd->ifd->pbuf); break;
+ default: ASSERT(0); return; /* -1; */
+ }
+
+ if (h <= (bytes_left)) {
+ driver_output(port_num, (char*) cpos, h);
+ cpos += h;
+ bytes_left -= h;
+ continue;
+ }
+ else { /* The last message we got was split */
+ char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h);
+ if (!buf) {
+ errno = ENOMEM;
+ port_inp_failure(dd, -1);
+ }
+ else {
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, h);
+ sys_memcpy(buf, cpos, bytes_left);
+ dd->ifd->buf = buf;
+ dd->ifd->sz = h;
+ dd->ifd->remain = h - bytes_left;
+ dd->ifd->cpos = buf + bytes_left;
+ }
+ break;
+ }
+ }
+ }
+ erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf);
+ }
+}
+
+
+/* fd is the drv_data that is returned from the */
+/* initial start routine */
+/* ready_fd is the descriptor that is ready to read */
+
+static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErlDrvPort ix = dd->port_num;
+ int n;
+ struct iovec* iv;
+ int vsize;
+
+ if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) {
+ driver_select(ix, ready_fd, ERL_DRV_WRITE, 0);
+ if (dd->pid > 0 && dd->ofd->fd < 0) {
+ /* The port was opened with 'in' option, which means we
+ should close the output fd as soon as the command has
+ been sent. */
+ driver_select(ix, ready_fd, ERL_DRV_WRITE|ERL_DRV_USE, 0);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData));
+ dd->ofd = NULL;
+ }
+ if (dd->terminating)
+ driver_failure_atom(dd->port_num,"normal");
+ return; /* 0; */
+ }
+ vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize;
+ if ((n = writev(ready_fd, iv, vsize)) > 0) {
+ if (driver_deq(ix, n) == 0)
+ set_busy_port(ix, 0);
+ }
+ else if (n < 0) {
+ if (errno == ERRNO_BLOCK || errno == EINTR)
+ return; /* 0; */
+ else {
+ int res = errno;
+ driver_select(ix, ready_fd, ERL_DRV_WRITE, 0);
+ driver_failure_posix(ix, res);
+ return; /* -1; */
+ }
+ }
+ return; /* 0; */
+}
+
+static void stop_select(ErlDrvEvent fd, void* _)
+{
+ close((int)fd);
+}
+
+#if FDBLOCK
+
+static void
+fd_async(void *async_data)
+{
+ int res;
+ ErtsSysDriverData *dd = (ErtsSysDriverData *)async_data;
+ SysIOVec *iov0;
+ SysIOVec *iov;
+ int iovlen;
+ int err = 0;
+ /* much of this code is stolen from efile_drv:invoke_writev */
+ driver_pdl_lock(dd->blocking->pdl);
+ iov0 = driver_peekq(dd->port_num, &iovlen);
+ iovlen = iovlen < MAXIOV ? iovlen : MAXIOV;
+ iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF,
+ sizeof(SysIOVec)*iovlen);
+ if (!iov) {
+ res = -1;
+ err = ENOMEM;
+ driver_pdl_unlock(dd->blocking->pdl);
+ } else {
+ memcpy(iov,iov0,iovlen*sizeof(SysIOVec));
+ driver_pdl_unlock(dd->blocking->pdl);
+
+ do {
+ res = writev(dd->ofd->fd, iov, iovlen);
+ } while (res < 0 && errno == EINTR);
+ if (res < 0)
+ err = errno;
+ err = errno;
+
+ erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov);
+ }
+ dd->blocking->res = res;
+ dd->blocking->err = err;
+}
+
+void fd_ready_async(ErlDrvData drv_data,
+ ErlDrvThreadData thread_data) {
+ ErtsSysDriverData *dd = (ErtsSysDriverData *)thread_data;
+ ErlDrvPort port_num = dd->port_num;
+
+ ASSERT(dd->blocking);
+
+ if (dd->blocking->res > 0) {
+ driver_pdl_lock(dd->blocking->pdl);
+ if (driver_deq(port_num, dd->blocking->res) == 0) {
+ driver_pdl_unlock(dd->blocking->pdl);
+ set_busy_port(port_num, 0);
+ if (dd->terminating) {
+ /* The port is has been ordered to terminate
+ from either fd_flush or port_inp_failure */
+ if (dd->terminating == 1)
+ driver_failure_atom(port_num, "normal");
+ else if (dd->terminating == 2)
+ driver_failure_eof(port_num);
+ else if (dd->terminating < 0)
+ driver_failure_posix(port_num, -dd->terminating);
+ return; /* -1; */
+ }
+ } else {
+ driver_pdl_unlock(dd->blocking->pdl);
+ /* still data left to write in queue */
+ driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL);
+ return /* 0; */;
+ }
+ } else if (dd->blocking->res < 0) {
+ if (dd->blocking->err == ERRNO_BLOCK) {
+ set_busy_port(port_num, 1);
+ /* still data left to write in queue */
+ driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL);
+ } else
+ driver_failure_posix(port_num, dd->blocking->err);
+ return; /* -1; */
+ }
+ return; /* 0; */
+}
+
+#endif
+
+/* Forker driver */
+
+static int forker_fd;
+
+static ErlDrvData forker_start(ErlDrvPort port_num, char* name,
+ SysDriverOpts* opts)
+{
+
+ int i;
+ int fds[2];
+ int res, unbind;
+ char bindir[MAXPATHLEN];
+ size_t bindirsz = sizeof(bindir);
+ Uint csp_path_sz;
+ char *child_setup_prog;
+
+ forker_port = erts_drvport2id(port_num);
+
+ res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz);
+ if (res != 0) {
+ if (res < 0)
+ 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_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) {
+ erl_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;
+ erl_exit(ERTS_DUMP_EXIT, "Failed to read from erl_child_setup: %d\n", errno);
+ }
+
+ if (res == 0)
+ erl_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;
+ erl_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;
+ }
+ erl_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_time.c b/erts/emulator/sys/unix/sys_time.c
index 2e1914f564..03d39c7ce6 100644
--- a/erts/emulator/sys/unix/sys_time.c
+++ b/erts/emulator/sys/unix/sys_time.c
@@ -65,6 +65,8 @@
# include <fcntl.h>
#endif
+static void init_perf_counter(void);
+
/******************* Routines for time measurement *********************/
#undef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__
@@ -404,6 +406,8 @@ sys_init_time(ErtsSysInitTimeResult *init_resp)
# error Missing erts_os_system_time() implementation
#endif
+ init_perf_counter();
+
}
void
@@ -908,10 +912,120 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
#endif
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Performance counter functions *
+\* */
+
+
+/* What resolution to spin to in micro seconds */
+#define RESOLUTION 100
+/* How many iterations to spin */
+#define ITERATIONS 1
+/* How many significant figures to round to */
+#define SIGFIGS 3
+
+static ErtsSysPerfCounter calculate_perf_counter_unit(void) {
+ int i;
+ ErtsSysPerfCounter pre, post;
+ double value = 0;
+ double round_factor;
+#if defined(HAVE_GETHRTIME) && defined(GETHRTIME_WITH_CLOCK_GETTIME)
+ struct timespec basetime,comparetime;
+#define __GETTIME(arg) clock_gettime(CLOCK_MONOTONIC,arg)
+#define __GETUSEC(arg) (arg.tv_nsec / 1000)
+#else
+ SysTimeval basetime,comparetime;
+#define __GETTIME(arg) sys_gettimeofday(arg)
+#define __GETUSEC(arg) arg.tv_usec
+#endif
+
+ for (i = 0; i < ITERATIONS; i++) {
+ /* Make sure usec just flipped over at current resolution */
+ __GETTIME(&basetime);
+ do {
+ __GETTIME(&comparetime);
+ } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION));
+
+ pre = erts_sys_perf_counter();
+
+ __GETTIME(&basetime);
+ do {
+ __GETTIME(&comparetime);
+ } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION));
+
+ post = erts_sys_perf_counter();
+
+ value += post - pre;
+ }
+ /* After this value is ticks per us */
+ value /= (RESOLUTION*ITERATIONS);
+
+ /* We round to 3 significant figures */
+ round_factor = pow(10.0, SIGFIGS - ceil(log10(value)));
+ value = ((ErtsSysPerfCounter)(value * round_factor + 0.5)) / round_factor;
+
+ /* convert to ticks per second */
+ return 1000000 * value;
+}
+
+static int have_rdtscp(void)
+{
+#if defined(ETHR_X86_RUNTIME_CONF__)
+ /* On early x86 cpu's the tsc varies with the current speed of the cpu,
+ which means that the time per tick vary depending on the current
+ load of the cpu. We do not want this as it would give very scewed
+ numbers when the cpu is mostly idle.
+ The linux kernel seems to think that checking for constant and
+ reliable is enough to trust the counter so we do the same.
+
+ If this test is not good enough, I don't know what we'll do.
+ Maybe fallback on erts_sys_hrtime always, but that would be a shame as
+ rdtsc is about 3 times faster than hrtime... */
+ return ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ &&
+ ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__;
+#else
+ return 0;
+#endif
+}
+
+static ErtsSysPerfCounter rdtsc(void)
+{
+ /* It may have been a good idea to put the cpuid instruction before
+ the rdtsc, but I decided against it because it is not really
+ needed for msacc, and it slows it down by quite a bit (5-7 times slower).
+ As a result though, this timestamp becomes much less
+ accurate as it might be re-ordered to be executed way before or after this
+ function is called.
+ */
+ ErtsSysPerfCounter ts;
+#if defined(__x86_64__)
+ __asm__ __volatile__ ("rdtsc\n\t"
+ "shl $32, %%rdx\n\t"
+ "or %%rdx, %0" : "=a" (ts) : : "rdx");
+#elif defined(__i386__)
+ __asm__ __volatile__ ("rdtsc\n\t"
+ : "=A" (ts) );
+#endif
+ return ts;
+}
+
+static void init_perf_counter(void)
+{
+ if (have_rdtscp()) {
+ erts_sys_time_data__.r.o.perf_counter = rdtsc;
+ erts_sys_time_data__.r.o.perf_counter_unit = calculate_perf_counter_unit();
+ } else {
+ erts_sys_time_data__.r.o.perf_counter = erts_sys_hrtime;
+ erts_sys_time_data__.r.o.perf_counter_unit = ERTS_HRTIME_UNIT;
+ }
+}
+
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
#ifdef HAVE_GETHRVTIME_PROCFS_IOCTL
+/* The code below only has effect on solaris < 10,
+ needed in order for gehhrvtime to work properly */
int sys_start_hrvtime(void)
{
long msacct = PR_MSACCT;
diff --git a/erts/emulator/sys/unix/sys_uds.c b/erts/emulator/sys/unix/sys_uds.c
new file mode 100644
index 0000000000..015d0346a1
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_uds.c
@@ -0,0 +1,155 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2002-2009. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "sys_uds.h"
+
+int
+sys_uds_readv(int fd, struct iovec *iov, size_t iov_len,
+ int *fds, int fd_count, int flags) {
+ struct msghdr msg;
+ struct cmsghdr *cmsg = NULL;
+ char ancillary_buff[256] = {0};
+ int res, i = 0;
+
+ /* setup a place to fill in message contents */
+ memset(&msg, 0, sizeof(struct msghdr));
+ msg.msg_iov = iov;
+ msg.msg_iovlen = iov_len;
+
+ /* provide space for the ancillary data */
+ msg.msg_control = ancillary_buff;
+ msg.msg_controllen = sizeof(ancillary_buff);
+
+ if((res = recvmsg(fd, &msg, flags)) < 0) {
+#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
+ /* When some OS X versions run out of fd's
+ they give EMSGSIZE instead of EMFILE.
+ We remap this as we want the correct
+ error to appear for the user */
+ if (errno == EMSGSIZE)
+ errno = EMFILE;
+#endif
+ return res;
+ }
+
+ if((msg.msg_flags & MSG_CTRUNC) == MSG_CTRUNC)
+ {
+ /* We assume that we have given enough space for any header
+ that are sent to us. So the only remaining reason to get
+ this flag set is if the caller has run out of file descriptors.
+ */
+ errno = EMFILE;
+ return -1;
+ }
+
+ for (cmsg = CMSG_FIRSTHDR(&msg); cmsg; cmsg = CMSG_NXTHDR(&msg, cmsg) ) {
+ if ((cmsg->cmsg_level == SOL_SOCKET) &&
+ (cmsg->cmsg_type == SCM_RIGHTS)) {
+ int *cmsg_data = (int *)CMSG_DATA(cmsg);
+ while ((char*)cmsg_data < (char*)cmsg + cmsg->cmsg_len) {
+ if (i < fd_count) {
+ fds[i++] = *cmsg_data++;
+ } else {
+ /* for some strange reason, we have received more FD's
+ than we wanted... close them if we are not running
+ debug. */
+ if(i >= fd_count) abort();
+ close(*cmsg_data++);
+ }
+ }
+ }
+ }
+
+ return res;
+}
+
+int
+sys_uds_read(int fd, char *buff, size_t len,
+ int *fds, int fd_count, int flags) {
+ struct iovec iov;
+ iov.iov_base = buff;
+ iov.iov_len = len;
+ return sys_uds_readv(fd, &iov, 1, fds, fd_count, flags);
+}
+
+
+int
+sys_uds_writev(int fd, struct iovec *iov, size_t iov_len,
+ int *fds, int fd_count, int flags) {
+
+ struct msghdr msg;
+ struct cmsghdr *cmsg = NULL;
+ int res, i;
+
+ /* initialize socket message */
+ memset(&msg, 0, sizeof(struct msghdr));
+
+ /* We flatten the iov if it is too long */
+ if (iov_len > MAXIOV) {
+ int size = 0;
+ char *buff;
+ for (i = 0; i < iov_len; i++)
+ size += iov[i].iov_len;
+ buff = malloc(size);
+
+ for (i = 0; i < iov_len; i++) {
+ memcpy(buff, iov[i].iov_base, iov[i].iov_len);
+ buff += iov[i].iov_len;
+ }
+
+ iov[0].iov_base = buff - size;
+ iov[0].iov_len = size;
+ msg.msg_iov = iov;
+ msg.msg_iovlen = 1;
+ } else {
+ msg.msg_iov = iov;
+ msg.msg_iovlen = iov_len;
+ }
+
+ /* initialize the ancillary data */
+ msg.msg_control = calloc(1, CMSG_SPACE(sizeof(int) * fd_count));
+ msg.msg_controllen = CMSG_SPACE(sizeof(int) * fd_count);
+
+ /* copy the fd array into the ancillary data */
+ cmsg = CMSG_FIRSTHDR(&msg);
+ if(!cmsg) abort();
+ cmsg->cmsg_level = SOL_SOCKET;
+ cmsg->cmsg_type = SCM_RIGHTS;
+ cmsg->cmsg_len = CMSG_LEN(sizeof(int) * fd_count);
+ memcpy(CMSG_DATA(cmsg), fds, sizeof(int) * fd_count);
+
+ res = sendmsg(fd, &msg, flags);
+
+ if (iov_len > MAXIOV)
+ free(iov[0].iov_base);
+
+ free(msg.msg_control);
+
+ return res;
+}
+
+int
+sys_uds_write(int fd, char *buff, size_t len,
+ int *fds, int fd_count, int flags) {
+ struct iovec iov;
+ iov.iov_base = buff;
+ iov.iov_len = len;
+ return sys_uds_writev(fd, &iov, 1, fds, fd_count, flags);
+}
diff --git a/erts/emulator/sys/unix/sys_uds.h b/erts/emulator/sys/unix/sys_uds.h
new file mode 100644
index 0000000000..844a2804d8
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_uds.h
@@ -0,0 +1,57 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2002-2009. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifndef _ERL_UNIX_UDS_H
+#define _ERL_UNIX_UDS_H
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#if defined(__sun__) && !defined(_XOPEN_SOURCE)
+#define _XOPEN_SOURCE 500
+#endif
+
+#include <limits.h>
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/uio.h>
+
+#if defined IOV_MAX
+#define MAXIOV IOV_MAX
+#elif defined UIO_MAXIOV
+#define MAXIOV UIO_MAXIOV
+#else
+#define MAXIOV 16
+#endif
+
+#include "sys.h"
+
+int sys_uds_readv(int fd, struct iovec *iov, size_t iov_len,
+ int *fds, int fd_count, int flags);
+int sys_uds_read(int fd, char *buff, size_t len,
+ int *fds, int fd_count, int flags);
+int sys_uds_writev(int fd, struct iovec *iov, size_t iov_len,
+ int *fds, int fd_count, int flags);
+int sys_uds_write(int fd, char *buff, size_t len,
+ int *fds, int fd_count, int flags);
+
+#endif /* #ifndef _ERL_UNIX_UDS_H */
diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c
index 466f4a3b48..660ded297a 100644
--- a/erts/emulator/sys/win32/erl_poll.c
+++ b/erts/emulator/sys/win32/erl_poll.c
@@ -27,6 +27,7 @@
#include "erl_alloc.h"
#include "erl_poll.h"
#include "erl_time.h"
+#include "erl_msacc.h"
/*
* Some debug macros
@@ -1188,16 +1189,19 @@ int erts_poll_wait(ErtsPollSet ps,
if (timeout > 0 && !erts_atomic32_read_nob(&break_waiter_state)) {
HANDLE harr[2] = {ps->event_io_ready, break_happened_event};
int num_h = 2;
+ ERTS_MSACC_PUSH_STATE_M();
HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout));
ERTS_POLLSET_UNLOCK(ps);
#ifdef ERTS_SMP
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
WaitForMultipleObjects(num_h, harr, FALSE, timeout);
#ifdef ERTS_SMP
erts_thr_progress_finalize_wait(NULL);
#endif
+ ERTS_MSACC_POP_STATE_M();
ERTS_POLLSET_LOCK(ps);
HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout));
woke_up(ps);
diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h
index 7e8dd8a4ca..99c1066ab3 100644
--- a/erts/emulator/sys/win32/erl_win_sys.h
+++ b/erts/emulator/sys/win32/erl_win_sys.h
@@ -183,6 +183,7 @@ typedef LONGLONG ErtsSysHrTime;
#endif
typedef ErtsMonotonicTime ErtsSystemTime;
+typedef ErtsMonotonicTime ErtsSysPerfCounter;
ErtsSystemTime erts_os_system_time(void);
@@ -213,6 +214,7 @@ ERTS_GLB_INLINE ErtsMonotonicTime erts_os_monotonic_time(void);
ERTS_GLB_INLINE void erts_os_times(ErtsMonotonicTime *,
ErtsSystemTime *);
ERTS_GLB_INLINE ErtsSysHrTime erts_sys_hrtime(void);
+ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -234,6 +236,18 @@ erts_sys_hrtime(void)
return (*erts_sys_time_data__.r.o.sys_hrtime)();
}
+ERTS_GLB_INLINE ErtsSysPerfCounter
+erts_sys_perf_counter(void)
+{
+ return (*erts_sys_time_data__.r.o.sys_hrtime)();
+}
+
+ERTS_GLB_INLINE ErtsSysPerfCounter
+erts_sys_perf_counter_unit(void)
+{
+ return 1000 * 1000 * 1000;
+}
+
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
extern void sys_gettimeofday(SysTimeval *tv);
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index fce76db28f..76ce25916a 100644
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -1334,10 +1334,8 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts)
retval = set_driver_data(dp, hFromChild, hToChild, opts->read_write,
opts->exit_status);
if (retval != ERL_DRV_ERROR_GENERAL && retval != ERL_DRV_ERROR_ERRNO) {
- Port *prt = erts_drvport2port(port_num);
- /* We assume that this cannot generate a negative number */
- ASSERT(prt != ERTS_INVALID_ERL_DRV_PORT);
- prt->os_pid = (SWord) pid;
+ /* We assume that this cannot generate a negative number */
+ erl_drv_set_os_pid(port_num, pid);
}
}
@@ -1528,8 +1526,8 @@ create_child_process
* Parse out the program name from the command line (it can be quoted and
* contain spaces).
*/
- newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, 2048*sizeof(wchar_t));
cmdlength = parse_command(origcmd);
+ newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, (MAX_PATH+wcslen(origcmd)-cmdlength)*sizeof(wchar_t));
thecommand = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, (cmdlength+1)*sizeof(wchar_t));
wcsncpy(thecommand, origcmd, cmdlength);
thecommand[cmdlength] = L'\0';
@@ -3273,6 +3271,12 @@ void erl_sys_init(void)
}
void
+erl_sys_late_init(void)
+{
+ /* do nothing */
+}
+
+void
erts_sys_schedule_interrupt(int set)
{
erts_check_io_interrupt(set);
diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c
index 9e5f78703a..3b4fd26d63 100644
--- a/erts/emulator/sys/win32/sys_time.c
+++ b/erts/emulator/sys/win32/sys_time.c
@@ -397,6 +397,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp)
erts_sys_time_data__.r.o.os_monotonic_time = os_mtime_func;
erts_sys_time_data__.r.o.os_times = os_times_func;
+ erts_sys_time_data__.r.o.sys_hrtime = sys_hrtime_func;
init_resp->os_monotonic_time_unit = time_unit;
init_resp->have_os_monotonic_time = 1;
init_resp->have_corrected_os_monotonic_time = 0;
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index 77614d455c..987a655c3d 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -79,6 +79,7 @@ MODULES= \
node_container_SUITE \
nofrag_SUITE \
num_bif_SUITE \
+ message_queue_data_SUITE \
op_SUITE \
port_SUITE \
port_bif_SUITE \
@@ -157,7 +158,7 @@ RELSYSDIR = $(RELEASE_PATH)/emulator_test
# FLAGS
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
# ----------------------------------------------------
# Targets
diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl
index 16f060fe34..a9bba9548b 100644
--- a/erts/emulator/test/a_SUITE.erl
+++ b/erts/emulator/test/a_SUITE.erl
@@ -27,7 +27,7 @@
%%%-------------------------------------------------------------------
-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]).
diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl
index 5017a83185..879fb03927 100644
--- a/erts/emulator/test/after_SUITE.erl
+++ b/erts/emulator/test/after_SUITE.erl
@@ -22,7 +22,7 @@
%% 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,
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index aa6a1fbcdc..332e2ad67d 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -36,7 +36,7 @@
-export([init_per_testcase/2, end_per_testcase/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(DEFAULT_TIMETRAP_SECS, 240).
@@ -122,13 +122,10 @@ migration(Cfg) ->
end.
erts_mmap(Config) when is_list(Config) ->
- case {?t:os_type(), is_halfword_vm()} of
- {{unix, _}, false} ->
+ case ?t:os_type() of
+ {unix, _} ->
[erts_mmap_do(Config, SCO, SCRPM, SCRFSD)
|| SCO <-[true,false], SCRFSD <-[1234,0], SCRPM <- [true,false]];
-
- {_,true} ->
- {skipped, "No supercarrier support on halfword vm"};
{SkipOs,_} ->
?line {skipped,
lists:flatten(["Not run on "
@@ -387,13 +384,6 @@ 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
- end.
-
free_memory() ->
%% Free memory in MB.
try
@@ -413,3 +403,4 @@ free_memory() ->
error : undef ->
?t:fail({"os_mon not built"})
end.
+
diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c
index 2f5f841e3d..44d982b6c7 100644
--- a/erts/emulator/test/alloc_SUITE_data/threads.c
+++ b/erts/emulator/test/alloc_SUITE_data/threads.c
@@ -96,16 +96,11 @@ static void fail(int t_no, char *frmt, ...)
exit_thread(t_no, 0);
}
-static Allctr_t *alloc_not_ts = NULL;
static Allctr_t *alloc_ts_1 = NULL;
static Allctr_t *alloc_ts_2 = NULL;
static void stop_allocators(void)
{
- if (alloc_not_ts) {
- STOP_ALC(alloc_not_ts);
- alloc_not_ts = NULL;
- }
if (alloc_ts_1) {
STOP_ALC(alloc_ts_1);
alloc_ts_1 = NULL;
@@ -155,7 +150,6 @@ testcase_run(TestCaseState_t *tcs)
if (!IS_THREADS_ENABLED)
testcase_skipped(tcs, "Threads not enabled");
- alloc_not_ts = NULL;
alloc_ts_1 = NULL;
alloc_ts_2 = NULL;
@@ -164,16 +158,12 @@ testcase_run(TestCaseState_t *tcs)
sprintf(sbct_buf, "%d", SBC_THRESHOLD/1024);
memcpy((void *) argv, argv_org, sizeof(argv_org));
- alloc_not_ts = START_ALC("threads_not_ts", 0, argv);
- ASSERT(tcs, alloc_not_ts);
- memcpy((void *) argv, argv_org, sizeof(argv_org));
alloc_ts_1 = START_ALC("threads_ts_1", 1, argv);
ASSERT(tcs, alloc_ts_1);
memcpy((void *) argv, argv_org, sizeof(argv_org));
alloc_ts_2 = START_ALC("threads_ts_2", 1, argv);
ASSERT(tcs, alloc_ts_2);
- ASSERT(tcs, !IS_ALLOC_THREAD_SAFE(alloc_not_ts));
ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_1));
ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_2));
@@ -190,12 +180,7 @@ testcase_run(TestCaseState_t *tcs)
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;
}
diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl
index 706a4a1c16..499b05d658 100644
--- a/erts/emulator/test/beam_SUITE.erl
+++ b/erts/emulator/test/beam_SUITE.erl
@@ -28,7 +28,7 @@
-export([applied/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl
index 9f14ca26e5..29c6a5c7ac 100644
--- a/erts/emulator/test/beam_literals_SUITE.erl
+++ b/erts/emulator/test/beam_literals_SUITE.erl
@@ -28,7 +28,7 @@
put_list/1, fconv/1, literal_case_expression/1,
increment/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl
index d6a771e7b9..9bba5387fa 100644
--- a/erts/emulator/test/bif_SUITE.erl
+++ b/erts/emulator/test/bif_SUITE.erl
@@ -20,7 +20,7 @@
-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,
@@ -32,7 +32,8 @@
specs/1,improper_bif_stubs/1,auto_imports/1,
t_list_to_existing_atom/1,os_env/1,otp_7526/1,
binary_to_atom/1,binary_to_existing_atom/1,
- atom_to_binary/1,min_max/1, erlang_halt/1]).
+ atom_to_binary/1,min_max/1, erlang_halt/1,
+ is_builtin/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -42,7 +43,7 @@ all() ->
t_list_to_existing_atom, os_env, otp_7526,
display,
atom_to_binary, binary_to_atom, binary_to_existing_atom,
- min_max, erlang_halt].
+ min_max, erlang_halt, is_builtin].
groups() ->
[].
@@ -716,6 +717,22 @@ wait_until_stable_size(File,PrevSz) ->
wait_until_stable_size(File,NewSz)
end.
+is_builtin(_Config) ->
+ Exp0 = [{M,F,A} || {M,_} <- code:all_loaded(),
+ {F,A} <- M:module_info(exports)],
+ Exp = ordsets:from_list(Exp0),
+
+ %% erlang:apply/3 is considered to be built-in, but is not
+ %% implemented as other BIFs.
+
+ Builtins0 = [{erlang,apply,3}|erlang:system_info(snifs)],
+ Builtins = ordsets:from_list(Builtins0),
+ NotBuiltin = ordsets:subtract(Exp, Builtins),
+ _ = [true = erlang:is_builtin(M, F, A) || {M,F,A} <- Builtins],
+ _ = [false = erlang:is_builtin(M, F, A) || {M,F,A} <- NotBuiltin],
+
+ ok.
+
%% Helpers
diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl
index e8f881f2a4..bb77235253 100644
--- a/erts/emulator/test/big_SUITE.erl
+++ b/erts/emulator/test/big_SUITE.erl
@@ -34,7 +34,7 @@
-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]}].
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 96ba2f64d4..c5e3226a13 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -40,7 +40,7 @@
%% phash2(Binary, N)
%%
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
@@ -521,30 +521,29 @@ external_size_1(Term, Size0, Limit) when Size0 < Limit ->
external_size_1(_, _, _) -> ok.
t_iolist_size(Config) when is_list(Config) ->
- ?line Seed = {erlang:monotonic_time(),
- erlang:time_offset(),
- erlang:unique_integer([positive])},
- ?line io:format("Seed: ~p", [Seed]),
- ?line random:seed(Seed),
- ?line Base = <<0:(1 bsl 20)/unit:8>>,
- ?line Powers = [1 bsl N || N <- lists:seq(2, 37)],
- ?line Sizes0 = [[N - random:uniform(N div 2),
- lists:seq(N-2, N+2),
- N+N div 2,
- N + random:uniform(N div 2)] ||
- N <- Powers],
+ _ = rand:uniform(), %Seed generator
+ io:format("Seed: ~p", [rand:export_seed()]),
+
+ Base = <<0:(1 bsl 20)/unit:8>>,
+ Powers = [1 bsl N || N <- lists:seq(2, 37)],
+ Sizes0 = [[N - rand:uniform(N div 2),
+ lists:seq(N-2, N+2),
+ N+N div 2,
+ N + rand:uniform(N div 2)] ||
+ N <- Powers],
+
%% Test sizes around 1^32 more thoroughly.
FourGigs = 1 bsl 32,
- ?line Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0,
- ?line Sizes2 = lists:flatten(Sizes1),
- ?line Sizes = lists:usort(Sizes2),
+ Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0,
+ Sizes2 = lists:flatten(Sizes1),
+ Sizes = lists:usort(Sizes2),
io:format("~p sizes:", [length(Sizes)]),
io:format("~p\n", [Sizes]),
- ?line [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes],
+ _ = [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes],
ok.
build_iolist(N, Base) when N < 16 ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 ->
<<Bin:N/binary,_/binary>> = Base,
Bin;
@@ -552,7 +551,7 @@ build_iolist(N, Base) when N < 16 ->
lists:seq(1, N)
end;
build_iolist(N, Base) when N =< byte_size(Base) ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 ->
<<Bin:N/binary,_/binary>> = Base,
Bin;
@@ -570,7 +569,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
@@ -1604,7 +1603,7 @@ bit_sized_binary(Bin0) ->
unaligned_sub_bin(Bin, 0) -> Bin;
unaligned_sub_bin(Bin0, Offs) ->
- F = random:uniform(256),
+ F = rand:uniform(256),
Roffs = 8-Offs,
Bin1 = <<F:Offs,Bin0/binary,F:Roffs>>,
Sz = size(Bin0),
diff --git a/erts/emulator/test/bs_bincomp_SUITE.erl b/erts/emulator/test/bs_bincomp_SUITE.erl
index dcd13c19df..8836fe40ae 100644
--- a/erts/emulator/test/bs_bincomp_SUITE.erl
+++ b/erts/emulator/test/bs_bincomp_SUITE.erl
@@ -131,7 +131,7 @@ tracing(Config) when is_list(Config) ->
random_binary() ->
Seq = [1,2,3,4,5,6,7,8,9,10],
- << <<($a + random:uniform($z - $a)):8>> || _ <- Seq >>.
+ << <<($a + rand:uniform($z - $a)):8>> || _ <- Seq >>.
random_binaries(N) when N > 0 ->
random_binary(),
diff --git a/erts/emulator/test/bs_bit_binaries_SUITE.erl b/erts/emulator/test/bs_bit_binaries_SUITE.erl
index a07fd7609c..0896fad8ed 100644
--- a/erts/emulator/test/bs_bit_binaries_SUITE.erl
+++ b/erts/emulator/test/bs_bit_binaries_SUITE.erl
@@ -30,7 +30,7 @@
big_binary_to_and_from_list/1,send_and_receive/1,
send_and_receive_alot/1,append/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl
index 7ed99f5b4e..1fa7353252 100644
--- a/erts/emulator/test/bs_construct_SUITE.erl
+++ b/erts/emulator/test/bs_construct_SUITE.erl
@@ -31,7 +31,7 @@
copy_writable_binary/1, kostis/1, dynamic/1, bs_add/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]}].
diff --git a/erts/emulator/test/bs_match_bin_SUITE.erl b/erts/emulator/test/bs_match_bin_SUITE.erl
index ba79643e69..2185e43498 100644
--- a/erts/emulator/test/bs_match_bin_SUITE.erl
+++ b/erts/emulator/test/bs_match_bin_SUITE.erl
@@ -24,7 +24,7 @@
init_per_group/2,end_per_group/2,
byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl
index 368f71978d..48c2b4644e 100644
--- a/erts/emulator/test/bs_match_int_SUITE.erl
+++ b/erts/emulator/test/bs_match_int_SUITE.erl
@@ -24,7 +24,7 @@
integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1,
match_huge_int/1,bignum/1,unaligned_32_bit/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-import(lists, [seq/2]).
diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl
index e875dc859c..b161d9544e 100644
--- a/erts/emulator/test/bs_match_misc_SUITE.erl
+++ b/erts/emulator/test/bs_match_misc_SUITE.erl
@@ -27,7 +27,7 @@
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]}].
diff --git a/erts/emulator/test/bs_match_tail_SUITE.erl b/erts/emulator/test/bs_match_tail_SUITE.erl
index 58b0d3fef6..baa86e6d4a 100644
--- a/erts/emulator/test/bs_match_tail_SUITE.erl
+++ b/erts/emulator/test/bs_match_tail_SUITE.erl
@@ -24,7 +24,7 @@
-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]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl
index 0625c22163..91e4e30dd2 100644
--- a/erts/emulator/test/bs_utf_SUITE.erl
+++ b/erts/emulator/test/bs_utf_SUITE.erl
@@ -28,7 +28,7 @@
utf32_illegal_sequences/1,
bad_construction/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])).
diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl
index 6a2588aadd..0e81141907 100644
--- a/erts/emulator/test/busy_port_SUITE.erl
+++ b/erts/emulator/test/busy_port_SUITE.erl
@@ -29,7 +29,7 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Internal exports.
-export([init/2]).
diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl
index 064404a038..b9f8fe52f3 100644
--- a/erts/emulator/test/call_trace_SUITE.erl
+++ b/erts/emulator/test/call_trace_SUITE.erl
@@ -39,7 +39,7 @@
-export([abbr/1,abbr/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(P, 20).
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 9f318a38be..3d2cc000a8 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -26,10 +26,11 @@
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]).
+ false_dependency/1,coverage/1,fun_confusion/1,
+ t_copy_literals/1]).
-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -38,7 +39,7 @@ all() ->
t_check_process_code_ets, t_check_old_code, external_fun, get_chunk,
module_md5, make_stub, make_stub_many_funs,
constant_pools, constant_refc_binaries, false_dependency,
- coverage, fun_confusion].
+ coverage, fun_confusion, t_copy_literals].
groups() ->
[].
@@ -753,6 +754,80 @@ compile_load(Mod, Src, Ver) ->
{module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1),
ok.
+
+t_copy_literals(Config) when is_list(Config) ->
+ %% Compile the the literals module.
+ Data = ?config(data_dir, Config),
+ File = filename:join(Data, "literals"),
+ {ok,literals,Code} = compile:file(File, [report,binary]),
+ {module,literals} = erlang:load_module(literals, Code),
+
+ N = 30,
+ Me = self(),
+ %% reload literals code every 567 ms
+ Rel = spawn_link(fun() -> reloader(literals,Code,567) end),
+ %% add new literal msgs to the loop every 789 ms
+ Sat = spawn_link(fun() -> saturate(Me,789) end),
+ %% run for 10s
+ _ = spawn_link(fun() -> receive after 10000 -> Me ! done end end),
+ ok = chase_msg(N, Me),
+ %% cleanup
+ Rel ! done,
+ Sat ! done,
+ ok = flush(),
+ ok.
+
+
+chase_msg(0, Pid) ->
+ chase_loop(Pid);
+chase_msg(N, Master) ->
+ Pid = spawn_link(fun() -> chase_msg(N - 1,Master) end),
+ chase_loop(Pid).
+
+chase_loop(Pid) ->
+ receive
+ done ->
+ Pid ! done,
+ ok;
+ {_From,Msg} ->
+ Pid ! {self(), Msg},
+ ok = traverse(Msg),
+ chase_loop(Pid)
+ end.
+
+saturate(Pid,Time) ->
+ Es = [msg1,msg2,msg3,msg4,msg5],
+ Msg = [literals:E()||E <- Es],
+ Pid ! {self(), Msg},
+ receive
+ done -> ok
+ after Time ->
+ saturate(Pid,Time)
+ end.
+
+traverse([]) -> ok;
+traverse([H|T]) ->
+ ok = traverse(H),
+ traverse(T);
+traverse(T) when is_tuple(T) -> ok;
+traverse(B) when is_binary(B) -> ok;
+traverse(I) when is_integer(I) -> ok;
+traverse(#{ 1 := V1, b := V2 }) ->
+ ok = traverse(V1),
+ ok = traverse(V2),
+ ok.
+
+
+reloader(Mod,Code,Time) ->
+ receive
+ done -> ok
+ after Time ->
+ code:purge(Mod),
+ {module,Mod} = erlang:load_module(Mod, Code),
+ reloader(Mod,Code,Time)
+ end.
+
+
%% Utilities.
make_sub_binary(Bin) when is_binary(Bin) ->
@@ -775,4 +850,7 @@ bit_sized_binary(Bin0) ->
BitSize = 8*size(Bin) + 1,
Bin.
+flush() ->
+ receive _ -> flush() after 0 -> ok end.
+
id(I) -> I.
diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl
index 9802d9d3f9..a36bfe09dd 100644
--- a/erts/emulator/test/code_SUITE_data/literals.erl
+++ b/erts/emulator/test/code_SUITE_data/literals.erl
@@ -20,6 +20,7 @@
-module(literals).
-export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]).
+-export([msg1/0,msg2/0,msg3/0,msg4/0,msg5/0]).
a() ->
{a,42.0,[7,38877938333399637266518333334747]}.
@@ -101,3 +102,9 @@ unused_binaries() ->
bits() ->
{bits,<<42:13,?MB_1>>}.
+
+msg1() -> "halloj".
+msg2() -> {"hello","world"}.
+msg3() -> <<"halloj">>.
+msg4() -> #{ 1=> "hello", b => "world"}.
+msg5() -> {1,2,3,4,5,6}.
diff --git a/erts/emulator/test/code_parallel_load_SUITE.erl b/erts/emulator/test/code_parallel_load_SUITE.erl
index b7ac0420cd..3998d27d04 100644
--- a/erts/emulator/test/code_parallel_load_SUITE.erl
+++ b/erts/emulator/test/code_parallel_load_SUITE.erl
@@ -39,7 +39,7 @@
-define(passes, 4).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/emulator/test/crypto_SUITE.erl b/erts/emulator/test/crypto_SUITE.erl
index 3622592586..41fe6a226c 100644
--- a/erts/emulator/test/crypto_SUITE.erl
+++ b/erts/emulator/test/crypto_SUITE.erl
@@ -20,7 +20,7 @@
-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,
diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl
index cabd6472d4..7ff727bcf5 100644
--- a/erts/emulator/test/ddll_SUITE.erl
+++ b/erts/emulator/test/ddll_SUITE.erl
@@ -52,7 +52,7 @@
-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]}].
diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl
index 6a5ca20ac3..58a8d390f0 100644
--- a/erts/emulator/test/decode_packet_SUITE.erl
+++ b/erts/emulator/test/decode_packet_SUITE.erl
@@ -22,7 +22,7 @@
-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,
@@ -53,11 +53,8 @@ end_per_group(_GroupName, Config) ->
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Seed = {S1,S2,S3} = {erlang:monotonic_time(),
- erlang:time_offset(),
- erlang:unique_integer()},
- random:seed(S1,S2,S3),
- io:format("*** SEED: ~p ***\n", [Seed]),
+ rand:seed(exsplus),
+ io:format("*** SEED: ~p ***\n", [rand:export_seed()]),
Dog=?t:timetrap(?t:minutes(1)),
[{watchdog, Dog}|Config].
@@ -136,7 +133,7 @@ pack(Type,Body,Rest,BitOffs) ->
{Packet,Unpacked} = pack(Type,Body),
%% Make Bin a sub-bin with an arbitrary bitoffset within Orig
- Prefix = random:uniform(1 bsl BitOffs) - 1,
+ Prefix = rand:uniform(1 bsl BitOffs) - 1,
Orig = <<Prefix:BitOffs,Packet/binary,Rest/bits>>,
<<_:BitOffs,Bin/bits>> = Orig,
{Bin,Unpacked,Orig}.
@@ -151,13 +148,13 @@ pack(4,Bin) ->
Psz = byte_size(Bin),
{<<Psz:32,Bin/binary>>, Bin};
pack(asn1,Bin) ->
- Ident = case random:uniform(3) of
+ 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
+ Length = case rand:uniform(4) of
1 when Psz < 128 ->
<<Psz:8>>;
R when R=<2 andalso Psz < 16#10000 ->
@@ -177,42 +174,42 @@ pack(sunrm,Bin) ->
{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
+ 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
+ _ -> 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
+ Content = case (rand:uniform(256) - 1) of
C when C<128 -> C;
_ -> v2hello
end,
- Major = random:uniform(256) - 1,
- Minor = random:uniform(256) - 1,
+ Major = rand:uniform(256) - 1,
+ Minor = rand:uniform(256) - 1,
pack_ssl(Content,Major,Minor,Bin).
pack_ssl(Content, Major, Minor, Body) ->
@@ -371,10 +368,10 @@ http_do({Bin,[{_Line,PL,PB}|Tail]}, Type) ->
?line {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
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index d71cedbdc5..7a33dbbb36 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -33,7 +33,7 @@
%% Tests distribution and the tcp driver.
--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,
diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index 4211c49848..8eb555a5b7 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -86,7 +86,7 @@
-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
@@ -224,7 +224,7 @@ outputv_errors_1(Term) ->
port_close(Port).
build_iolist(N, Base) when N < 16 ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 ->
<<Bin:N/binary,_/binary>> = Base,
Bin;
@@ -232,7 +232,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;
@@ -250,7 +250,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
@@ -1877,10 +1877,7 @@ 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,
+ MemName = "all memory",
?line [{memkind,DrvMem}]
= lists:filter(fun(E) -> case E of
{memkind, [{name, MemName} | _]} -> true;
@@ -1899,13 +1896,6 @@ mseg_inst_info(I) ->
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
@@ -2405,13 +2395,35 @@ z_test(Config) when is_list(Config) ->
check_io_debug() ->
get_stable_check_io_info(),
- {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs}
+ {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug
= erts_debug:get_internal_state(check_io_debug),
+ HasGetHost = has_gethost(),
+ ct:log("check_io_debug: ~p~n"
+ "HasGetHost: ~p",[CheckIoDebug, HasGetHost]),
0 = NoErrorFds,
- NoUsedFds = NoDrvSelStructs,
+ if
+ NoUsedFds == NoDrvSelStructs ->
+ ok;
+ HasGetHost andalso (NoUsedFds == (NoDrvSelStructs - 1)) ->
+ %% If the inet_gethost port is alive, we may have
+ %% one extra used fd that is not selected on
+ ok
+ end,
0 = NoDrvEvStructs,
ok.
+has_gethost() ->
+ has_gethost(erlang:ports()).
+has_gethost([P|T]) ->
+ case erlang:port_info(P, name) of
+ {name,"inet_gethost"++_} ->
+ true;
+ _ ->
+ has_gethost(T)
+ end;
+has_gethost([]) ->
+ false.
+
%flush_msgs() ->
% receive
% M ->
@@ -2512,14 +2524,7 @@ random_char() ->
uniform(256) - 1.
uniform(N) ->
- case get(random_seed) of
- undefined ->
- {X, Y, Z} = time(),
- random:seed(X, Y, Z);
- _ ->
- ok
- end,
- random:uniform(N).
+ rand:uniform(N).
erl_millisecs() ->
erl_millisecs(erlang:monotonic_time()).
diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl
index 4d8d89db9b..cb26e8e736 100644
--- a/erts/emulator/test/efile_SUITE.erl
+++ b/erts/emulator/test/efile_SUITE.erl
@@ -24,7 +24,7 @@
-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]}].
diff --git a/erts/emulator/test/emulator.spec.ose b/erts/emulator/test/emulator.spec.ose
deleted file mode 100644
index 9f494609d9..0000000000
--- a/erts/emulator/test/emulator.spec.ose
+++ /dev/null
@@ -1,2 +0,0 @@
-{topcase, {dir, "../emulator_test"}}.
-{skip, {obsolete_SUITE, "Not on ose"}}.
diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl
index 2cd569ce4f..26d00db7c0 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE.erl
+++ b/erts/emulator/test/erl_drv_thread_SUITE.erl
@@ -25,7 +25,7 @@
-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).
diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl
index a7a45046ca..56b2c9c6ee 100644
--- a/erts/emulator/test/erl_link_SUITE.erl
+++ b/erts/emulator/test/erl_link_SUITE.erl
@@ -29,7 +29,7 @@
-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]).
diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl
index 35677f9953..440a7950a6 100644
--- a/erts/emulator/test/erts_debug_SUITE.erl
+++ b/erts/emulator/test/erts_debug_SUITE.erl
@@ -19,18 +19,18 @@
%%
-module(erts_debug_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
- test_size/1,flat_size_big/1,df/1,
+ test_size/1,flat_size_big/1,df/1,term_type/1,
instructions/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [test_size, flat_size_big, df, instructions].
+ [test_size, flat_size_big, df, instructions, term_type].
groups() ->
[].
@@ -138,6 +138,47 @@ flat_size_big_1(Term, Size0, Limit) when Size0 < Limit ->
end;
flat_size_big_1(_, _, _) -> ok.
+
+term_type(Config) when is_list(Config) ->
+ Ts = [{fixnum, 1},
+ {fixnum, -1},
+ {bignum, 1 bsl 300},
+ {bignum, -(1 bsl 300)},
+ {hfloat, 0.0},
+ {hfloat, 0.0/-1},
+ {hfloat, 1.0/(1 bsl 302)},
+ {hfloat, 1.0*(1 bsl 302)},
+ {hfloat, -1.0/(1 bsl 302)},
+ {hfloat, -1.0*(1 bsl 302)},
+ {hfloat, 3.1416},
+ {hfloat, 1.0e18},
+ {hfloat, -3.1416},
+ {hfloat, -1.0e18},
+
+ {heap_binary, <<1,2,3>>},
+ {refc_binary, <<0:(8*80)>>},
+ {sub_binary, <<5:7>>},
+
+ {flatmap, #{ a => 1}},
+ {hashmap, maps:from_list([{I,I}||I <- lists:seq(1,76)])},
+
+ {list, [1,2,3]},
+ {nil, []},
+ {tuple, {1,2,3}},
+ {tuple, {}},
+
+ {export, fun lists:sort/1},
+ {'fun', fun() -> ok end},
+ {pid, self()},
+ {atom, atom}],
+ lists:foreach(fun({E,Val}) ->
+ R = erts_internal:term_type(Val),
+ io:format("expecting term type ~w, got ~w (~p)~n", [E,R,Val]),
+ E = R
+ end, Ts),
+ ok.
+
+
df(Config) when is_list(Config) ->
P0 = pps(),
PrivDir = ?config(priv_dir, Config),
diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl
index dc8f0aaee9..7be55eca8d 100644
--- a/erts/emulator/test/estone_SUITE.erl
+++ b/erts/emulator/test/estone_SUITE.erl
@@ -46,7 +46,7 @@
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
diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl
index 484d2a8bf5..77ee2128b6 100644
--- a/erts/emulator/test/evil_SUITE.erl
+++ b/erts/emulator/test/evil_SUITE.erl
@@ -33,7 +33,7 @@
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]}].
@@ -382,10 +382,10 @@ my_appender_1(N, T0) ->
my_appender_1(N-1, T).
seed() ->
- random:seed(3172, 9815, 20129).
+ rand:seed(exsplus, {3172,9815,20129}).
rnd_term() ->
- U0 = random:uniform(),
+ U0 = rand:uniform(),
B = <<U0/float>>,
{U0,U0 * 2.5 + 3.14,[U0*2.3,B]}.
diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl
index 11caea3698..57ce8fb879 100644
--- a/erts/emulator/test/exception_SUITE.erl
+++ b/erts/emulator/test/exception_SUITE.erl
@@ -29,7 +29,7 @@
-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]}].
diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl
index c1a76b8af4..bf557f2bca 100644
--- a/erts/emulator/test/float_SUITE.erl
+++ b/erts/emulator/test/float_SUITE.erl
@@ -20,15 +20,17 @@
-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,
+ 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) ->
@@ -45,6 +47,7 @@ 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() ->
@@ -328,3 +331,124 @@ 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 -> ?t:fail({R,Val})
+ end.
+
+t_mul_add_ops(Config) when is_list(Config) ->
+ check_epsilon(op_mul_add(1, 2.0, 1.0, 0.0), 1.0),
+ check_epsilon(op_mul_add(2, 2.0, 1.0, 0.0), 3.0),
+ check_epsilon(op_mul_add(3, 2.0, 1.0, 0.0), 7.0),
+ check_epsilon(op_mul_add(4, 2.0, 1.0, 0.0), 15.0),
+ check_epsilon(op_mul_add(5, 2.0, 1.0, 0.0), 31.0),
+ check_epsilon(op_mul_add(6, 2.0, 1.0, 0.0), 63.0),
+ check_epsilon(op_mul_add(6, 2.0, 1.3, 0.0), 81.9),
+ check_epsilon(op_mul_add(6, 2.03, 1.3, 0.0), 87.06260151458997),
+ ok.
+
+
+op_mul_add(0, _, _, R) -> R;
+op_mul_add(N, A, B, R) when is_float(A), is_float(B), is_float(R) ->
+ op_mul_add(N - 1, A, B, R * A + B).
+
diff --git a/erts/emulator/test/float_SUITE_data/fp_drv.c b/erts/emulator/test/float_SUITE_data/fp_drv.c
index 5919dd8e2f..a91d622040 100644
--- a/erts/emulator/test/float_SUITE_data/fp_drv.c
+++ b/erts/emulator/test/float_SUITE_data/fp_drv.c
@@ -18,6 +18,7 @@
*/
#if defined(DEBUG) || 0
+# include <stdio.h>
# define PRINTF(X) printf X
#else
# define PRINTF(X)
diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl
index b18f9f5c6b..6697a86fc5 100644
--- a/erts/emulator/test/fun_SUITE.erl
+++ b/erts/emulator/test/fun_SUITE.erl
@@ -35,7 +35,7 @@
-export([nothing/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/emulator/test/fun_r13_SUITE.erl b/erts/emulator/test/fun_r13_SUITE.erl
index 7ab5e65cb3..39e8b3c324 100644
--- a/erts/emulator/test/fun_r13_SUITE.erl
+++ b/erts/emulator/test/fun_r13_SUITE.erl
@@ -26,7 +26,7 @@
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").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl
index 1e155e7b09..cb000fd45f 100644
--- a/erts/emulator/test/gc_SUITE.erl
+++ b/erts/emulator/test/gc_SUITE.erl
@@ -22,7 +22,7 @@
-module(gc_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]).
diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
index b3a85c6423..2e03983c4f 100644
--- a/erts/emulator/test/guard_SUITE.erl
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -25,7 +25,7 @@
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]).
diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl
index 2ea49467b8..31b10158fb 100644
--- a/erts/emulator/test/hash_SUITE.erl
+++ b/erts/emulator/test/hash_SUITE.erl
@@ -50,7 +50,7 @@
-define(config(A,B),config(A,B)).
-export([config/2]).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-endif.
-ifdef(debug).
@@ -223,11 +223,10 @@ basic_test() ->
range_test() ->
- random:seed(),
F = fun(From,From,_FF) ->
ok;
(From,To,FF) ->
- R = random:uniform(16#FFFFFFFFFFFFFFFF),
+ R = rand:uniform(16#FFFFFFFFFFFFFFFF),
X = erlang:phash(R, From),
Y = erlang:phash(R, 16#100000000) - 1,
Z = (Y rem From) + 1,
@@ -265,14 +264,13 @@ spread_test(N) ->
cmp_test(N) ->
- % No need to save seed, the error indicates what number caused it.
- random:seed(),
do_cmp_hashes(N,8).
+
do_cmp_hashes(0,_) ->
ok;
do_cmp_hashes(N,Steps) ->
- R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF),
- R = case random:uniform(2) of
+ R0 = rand:uniform(1 bsl Steps - 1) + rand:uniform(16#FFFFFFFF),
+ R = case rand:uniform(2) of
1 ->
R0;
_ ->
diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl
index 4ac8c272db..5138a6ee05 100644
--- a/erts/emulator/test/hibernate_SUITE.erl
+++ b/erts/emulator/test/hibernate_SUITE.erl
@@ -20,7 +20,7 @@
-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,
diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl
index 13f34cd10f..e40b91392c 100644
--- a/erts/emulator/test/ignore_cores.erl
+++ b/erts/emulator/test/ignore_cores.erl
@@ -28,7 +28,7 @@
-module(ignore_cores).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]).
diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl
index 9e930822cf..544f9c9c1f 100644
--- a/erts/emulator/test/list_bif_SUITE.erl
+++ b/erts/emulator/test/list_bif_SUITE.erl
@@ -19,7 +19,7 @@
%%
-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,
diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl
index a256cf4195..5e9814be60 100644
--- a/erts/emulator/test/map_SUITE.erl
+++ b/erts/emulator/test/map_SUITE.erl
@@ -1511,11 +1511,8 @@ t_map_equal(Config) when is_list(Config) ->
t_map_compare(Config) when is_list(Config) ->
- Seed = {erlang:monotonic_time(),
- erlang:time_offset(),
- erlang:unique_integer()},
- io:format("seed = ~p\n", [Seed]),
- random:seed(Seed),
+ rand:seed(exsplus),
+ io:format("seed = ~p\n", [rand:export_seed()]),
repeat(100, fun(_) -> float_int_compare() end, []),
repeat(100, fun(_) -> recursive_compare() end, []),
ok.
@@ -1533,7 +1530,7 @@ float_int_compare() ->
numeric_keys(N) ->
lists:foldl(fun(_,Acc) ->
- Int = random:uniform(N*4) - N*2,
+ Int = rand:uniform(N*4) - N*2,
Float = float(Int),
[Int, Float, Float * 0.99, Float * 1.01 | Acc]
end,
@@ -1564,7 +1561,7 @@ do_compare([Gen1, Gen2]) ->
%% Change one key from int to float (or vice versa) and check compare
ML1 = maps:to_list(M1),
- {K1,V1} = lists:nth(random:uniform(length(ML1)), ML1),
+ {K1,V1} = lists:nth(rand:uniform(length(ML1)), ML1),
case K1 of
I when is_integer(I) ->
case maps:find(float(I),M1) of
@@ -1655,9 +1652,9 @@ cmp_others(T1, T2, _) ->
map_gen(Pairs, Size) ->
{_,L} = lists:foldl(fun(_, {Keys, Acc}) ->
- KI = random:uniform(size(Keys)),
+ KI = rand:uniform(size(Keys)),
K = element(KI,Keys),
- KV = element(random:uniform(size(K)), K),
+ KV = element(rand:uniform(size(K)), K),
{erlang:delete_element(KI,Keys), [KV | Acc]}
end,
{Pairs, []},
@@ -1697,15 +1694,15 @@ term_gen_recursive(Leafs, Flags, Depth) ->
MaxDepth = 10,
Rnd = case {Flags, Depth} of
{_, MaxDepth} -> % Only leafs
- random:uniform(size(Leafs)) + 3;
+ rand:uniform(size(Leafs)) + 3;
{0, 0} -> % Only containers
- random:uniform(3);
+ rand:uniform(3);
{0,_} -> % Anything
- random:uniform(size(Leafs)+3)
+ rand:uniform(size(Leafs)+3)
end,
case Rnd of
1 -> % Make map
- Size = random:uniform(size(Leafs)),
+ Size = rand:uniform(size(Leafs)),
lists:foldl(fun(_, {Acc1,Acc2}) ->
{K1,K2} = term_gen_recursive(Leafs, Flags,
Depth+1),
@@ -1720,7 +1717,7 @@ term_gen_recursive(Leafs, Flags, Depth) ->
{Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1),
{[Car1 | Cdr1], [Car2 | Cdr2]};
3 -> % Make tuple
- Size = random:uniform(size(Leafs)),
+ Size = rand:uniform(size(Leafs)),
L = lists:map(fun(_) -> term_gen_recursive(Leafs, Flags, Depth+1) end,
lists:seq(1,Size)),
{L1, L2} = lists:unzip(L),
@@ -1729,7 +1726,7 @@ term_gen_recursive(Leafs, Flags, Depth) ->
N -> % Make leaf
case element(N-3, Leafs) of
I when is_integer(I) ->
- case random:uniform(4) of
+ case rand:uniform(4) of
1 -> {I, float(I)};
2 -> {float(I), I};
_ -> {I,I}
@@ -2598,7 +2595,7 @@ hashmap_balance(KeyFun) ->
F = fun(I, {M0,Max0}) ->
Key = KeyFun(I),
M1 = M0#{Key => Key},
- Max1 = case erts_internal:map_type(M1) of
+ Max1 = case erts_internal:term_type(M1) of
hashmap ->
Nodes = hashmap_nodes(M1),
Avg = maps:size(M1) * 0.4,
@@ -3006,7 +3003,7 @@ t_gc_rare_map_overflow(Config) ->
Loop()
end),
FatMap = fatmap(34),
- false = (flatmap =:= erts_internal:map_type(FatMap)),
+ false = (flatmap =:= erts_internal:term_type(FatMap)),
t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> erlang:garbage_collect() end),
diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl
index 3f986ca2ed..9e724bdd8c 100644
--- a/erts/emulator/test/match_spec_SUITE.erl
+++ b/erts/emulator/test/match_spec_SUITE.erl
@@ -39,7 +39,7 @@
% This test suite assumes that tracing in general works. What we test is
% the match spec functionality.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init_per_testcase/2, end_per_testcase/2]).
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..96c41a57b5
--- /dev/null
+++ b/erts/emulator/test/message_queue_data_SUITE.erl
@@ -0,0 +1,239 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(message_queue_data_SUITE).
+
+-export([all/0, suite/0,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([basic/1, process_info_messages/1]).
+
+-export([basic_test/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+init_per_testcase(Case, Config) ->
+ ?line Dog=test_server:timetrap(test_server:minutes(2)),
+ [{watchdog, Dog}, {testcase, Case}|Config].
+
+end_per_testcase(_, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [basic, process_info_messages].
+
+groups() ->
+ [].
+
+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.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+%%
+%%
+%% Test cases
+%%
+%%
+
+basic(Config) when is_list(Config) ->
+
+ basic_test(erlang:system_info(message_queue_data)),
+
+ {ok, Node1} = start_node(Config, "+xmqd off_heap"),
+ ok = rpc:call(Node1, ?MODULE, basic_test, [off_heap]),
+ stop_node(Node1),
+
+ {ok, Node2} = start_node(Config, "+xmqd on_heap"),
+ ok = rpc:call(Node2, ?MODULE, basic_test, [on_heap]),
+ stop_node(Node2),
+
+ {ok, Node3} = start_node(Config, "+xmqd mixed"),
+ ok = rpc:call(Node3, ?MODULE, basic_test, [mixed]),
+ stop_node(Node3),
+
+ ok.
+
+is_valid_mqd_value(off_heap) ->
+ true;
+is_valid_mqd_value(on_heap) ->
+ true;
+is_valid_mqd_value(mixed) ->
+ true;
+is_valid_mqd_value(_) ->
+ false.
+
+
+basic_test(Default) ->
+
+ Default = erlang:system_info(message_queue_data),
+ true = is_valid_mqd_value(Default),
+
+ {message_queue_data, Default} = process_info(self(), message_queue_data),
+ Default = process_flag(message_queue_data, off_heap),
+ {message_queue_data, off_heap} = process_info(self(), message_queue_data),
+ off_heap = process_flag(message_queue_data, on_heap),
+ {message_queue_data, on_heap} = process_info(self(), message_queue_data),
+ on_heap = process_flag(message_queue_data, mixed),
+ {message_queue_data, mixed} = process_info(self(), message_queue_data),
+ mixed = process_flag(message_queue_data, Default),
+ {'EXIT', _} = (catch process_flag(message_queue_data, blupp)),
+
+ P1 = spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link]),
+ {message_queue_data, Default} = process_info(P1, message_queue_data),
+ unlink(P1),
+ exit(P1, bye),
+
+ P2 = spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link, {message_queue_data, off_heap}]),
+ {message_queue_data, off_heap} = process_info(P2, message_queue_data),
+ unlink(P2),
+ exit(P2, bye),
+
+ P3 = spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link, {message_queue_data, on_heap}]),
+ {message_queue_data, on_heap} = process_info(P3, message_queue_data),
+ unlink(P3),
+ exit(P3, bye),
+
+ P4 = spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link, {message_queue_data, mixed}]),
+ {message_queue_data, mixed} = process_info(P4, message_queue_data),
+ unlink(P4),
+ exit(P4, bye),
+
+ {'EXIT', _} = (catch spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link, {message_queue_data, blapp}])),
+
+ ok.
+
+process_info_messages(Config) when is_list(Config) ->
+ Tester = self(),
+ P1 = spawn_opt(fun () ->
+ receive after 500 -> ok end,
+ mixed = process_flag(message_queue_data, off_heap),
+ Tester ! first,
+ receive after 500 -> ok end,
+ off_heap = process_flag(message_queue_data, on_heap),
+ Tester ! second,
+ receive after 500 -> ok end,
+ on_heap = process_flag(message_queue_data, mixed),
+ Tester ! third,
+ receive after 500 -> ok end,
+ mixed = process_flag(message_queue_data, off_heap),
+ Tester ! fourth,
+
+ receive after infinity -> ok end
+ end,
+ [link, {message_queue_data, mixed}]),
+
+ P1 ! "A",
+ receive first -> ok end,
+ P1 ! "B",
+ receive second -> ok end,
+ P1 ! "C",
+ receive third -> ok end,
+ P1 ! "D",
+ receive fourth -> ok end,
+ P1 ! "E",
+
+ {messages, ["A", "B", "C", "D", "E"]} = process_info(P1, messages),
+
+ P2 = spawn_opt(fun () ->
+ receive after 500 -> ok end,
+ mixed = process_flag(message_queue_data, off_heap),
+ Tester ! first,
+ receive after 500 -> ok end,
+ off_heap = process_flag(message_queue_data, on_heap),
+ Tester ! second,
+ receive after 500 -> ok end,
+ on_heap = process_flag(message_queue_data, mixed),
+ Tester ! third,
+ receive after 500 -> ok end,
+ mixed = process_flag(message_queue_data, off_heap),
+ Tester ! fourth,
+ receive after 500 -> ok end,
+
+ Tester ! process_info(self(), messages),
+
+ receive M1 -> M1 = "A" end,
+ receive M2 -> M2 = "B" end,
+ receive M3 -> M3 = "C" end,
+ receive M4 -> M4 = "D" end,
+ receive M5 -> M5 = "E" end,
+
+ Tester ! self()
+ end,
+ [link, {message_queue_data, mixed}]),
+
+ P2 ! "A",
+ receive first -> ok end,
+ P2 ! "B",
+ receive second -> ok end,
+ P2 ! "C",
+ receive third -> ok end,
+ P2 ! "D",
+ receive fourth -> ok end,
+ P2 ! "E",
+
+ receive
+ Msg ->
+ {messages, ["A", "B", "C", "D", "E"]} = Msg
+ end,
+
+ receive P2 -> ok end,
+
+ ok.
+
+%%
+%%
+%% helpers
+%%
+%%
+
+start_node(Config) ->
+ start_node(Config, []).
+start_node(Config, Opts) when is_list(Config), is_list(Opts) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ Name = list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(?config(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl
index 7c2101ca05..c622a2d8d7 100644
--- a/erts/emulator/test/module_info_SUITE.erl
+++ b/erts/emulator/test/module_info_SUITE.erl
@@ -20,7 +20,7 @@
-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,
diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl
index 4db17969c0..8101908df1 100644
--- a/erts/emulator/test/monitor_SUITE.erl
+++ b/erts/emulator/test/monitor_SUITE.erl
@@ -20,7 +20,7 @@
-module(monitor_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
diff --git a/erts/emulator/test/nested_SUITE.erl b/erts/emulator/test/nested_SUITE.erl
index 7cfa837ee5..ee6bbf6a55 100644
--- a/erts/emulator/test/nested_SUITE.erl
+++ b/erts/emulator/test/nested_SUITE.erl
@@ -24,7 +24,7 @@
init_per_group/2,end_per_group/2,
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]}].
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index e10460ce78..7ce37b04b3 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -24,7 +24,7 @@
-define(CHECK(Exp,Got), check(Exp,Got,?LINE)).
%%-define(CHECK(Exp,Got), ?line Exp = Got).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
@@ -1193,11 +1193,8 @@ send3(Config) when is_list(Config) ->
%% Let a number of processes send random message blobs between each other
%% using enif_send. Kill and spawn new ones randomly to keep a ~constant
%% number of workers running.
- Seed = {erlang:monotonic_time(),
- erlang:time_offset(),
- erlang:unique_integer()},
- io:format("seed: ~p\n",[Seed]),
- random:seed(Seed),
+ rand:seed(exsplus),
+ io:format("seed: ~p\n",[rand:export_seed()]),
ets:new(nif_SUITE,[named_table,public]),
?line true = ets:insert(nif_SUITE,{send3,0,0,0,0}),
timer:send_after(10000, timeout), % Run for 10 seconds
@@ -1230,7 +1227,7 @@ 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 ->
@@ -1294,7 +1291,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
@@ -1306,12 +1303,12 @@ send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) ->
send3_make_blob() ->
- case random:uniform(20)-1 of
+ case rand:uniform(20)-1 of
0 -> {term,[]};
N ->
MsgEnv = alloc_msgenv(),
repeat(N bsr 1,
- fun(_) -> grow_blob(MsgEnv,other_term(),random:uniform(1 bsl 20))
+ fun(_) -> grow_blob(MsgEnv,other_term(),rand:uniform(1 bsl 20))
end, void),
case (N band 1) of
0 -> {term,copy_blob(MsgEnv)};
@@ -1321,7 +1318,7 @@ send3_make_blob() ->
send3_send(Pid, Msg) ->
%% 90% enif_send and 10% normal bang
- case random:uniform(10) of
+ case rand:uniform(10) of
1 -> send3_send_bang(Pid,Msg);
_ -> send3_send_nif(Pid,Msg)
end.
@@ -1342,7 +1339,7 @@ send3_send_bang(Pid, {msgenv,MsgEnv}) ->
true.
send3_new_state(State, Blob) ->
- case random:uniform(5+2) of
+ case rand:uniform(5+2) of
N when N =< 5-> setelement(N, State, Blob);
_ -> State % Don't store blob
end.
@@ -1400,7 +1397,7 @@ is_checks(Config) when is_list(Config) ->
get_length(doc) -> ["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).
+ ?line ok = length_test(hejsan, "hejsan", [], [], not_a_list, [1,2|3]).
ensure_lib_loaded(Config) ->
ensure_lib_loaded(Config, 1).
@@ -1953,7 +1950,7 @@ last_resource_dtor_call() -> ?nif_stub.
make_new_resource(_,_) -> ?nif_stub.
check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
check_is_exception() -> ?nif_stub.
-length_test(_,_,_,_,_) -> ?nif_stub.
+length_test(_,_,_,_,_,_) -> ?nif_stub.
make_atoms() -> ?nif_stub.
make_strings() -> ?nif_stub.
make_new_resource_binary(_) -> ?nif_stub.
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index 8ebce4fef4..1acb270d1f 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -914,6 +914,7 @@ static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_T
* argv[2] empty list
* argv[3] not an atom
* argv[4] not a list
+ * argv[5] improper list
*/
static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
@@ -934,6 +935,9 @@ static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
if (enif_get_list_length(env, argv[4], &len))
return enif_make_badarg(env);
+ if (enif_get_list_length(env, argv[5], &len))
+ return enif_make_badarg(env);
+
return enif_make_atom(env, "ok");
}
@@ -2002,7 +2006,7 @@ static ErlNifFunc nif_funcs[] =
{"make_new_resource", 2, make_new_resource},
{"check_is", 11, check_is},
{"check_is_exception", 0, check_is_exception},
- {"length_test", 5, length_test},
+ {"length_test", 6, length_test},
{"make_atoms", 0, make_atoms},
{"make_strings", 0, make_strings},
{"make_new_resource", 2, make_new_resource},
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.erl b/erts/emulator/test/nif_SUITE_data/nif_mod.erl
index e65d4577c7..aa3c90fe9d 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.erl
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl
@@ -20,7 +20,7 @@
-module(nif_mod).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([load_nif_lib/2, load_nif_lib/3, start/0, lib_version/0, call_history/0,
get_priv_data_ptr/0, make_new_resource/2, get_resource/2]).
diff --git a/erts/emulator/test/nif_SUITE_data/tester.erl b/erts/emulator/test/nif_SUITE_data/tester.erl
index b393e29b82..32b9ef1826 100644
--- a/erts/emulator/test/nif_SUITE_data/tester.erl
+++ b/erts/emulator/test/nif_SUITE_data/tester.erl
@@ -1,6 +1,6 @@
-module(tester).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([load_nif_lib/2, run/0]).
diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl
index fecaad5232..dcd0428e65 100644
--- a/erts/emulator/test/node_container_SUITE.erl
+++ b/erts/emulator/test/node_container_SUITE.erl
@@ -30,7 +30,7 @@
%-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,
diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl
index 3660a58c56..caa2d30a6c 100644
--- a/erts/emulator/test/nofrag_SUITE.erl
+++ b/erts/emulator/test/nofrag_SUITE.erl
@@ -20,7 +20,7 @@
-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,
diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl
index 90b6a36262..04a6f9d18d 100644
--- a/erts/emulator/test/num_bif_SUITE.erl
+++ b/erts/emulator/test/num_bif_SUITE.erl
@@ -1,8 +1,8 @@
%%
%% %CopyrightBegin%
-%%
+%%
%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
-%%
+%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -14,13 +14,13 @@
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
-%%
+%%
%% %CopyrightEnd%
%%
-module(num_bif_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Tests the BIFs:
%% abs/1
@@ -36,22 +36,22 @@
%% integer_to_binary/2
%% binary_to_integer/1
--export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1,
+-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1,
init_per_group/2, end_per_group/2, t_abs/1, t_float/1,
t_float_to_string/1, t_integer_to_string/1,
- t_string_to_integer/1,
+ t_string_to_integer/1, t_list_to_integer_edge_cases/1,
t_string_to_float_safe/1, t_string_to_float_risky/1,
t_round/1, t_trunc/1
]).
suite() -> [{ct_hooks,[ts_install_cth]}].
-all() ->
+all() ->
[t_abs, t_float, t_float_to_string, t_integer_to_string,
{group, t_string_to_float}, t_string_to_integer, t_round,
- t_trunc].
+ t_trunc, t_list_to_integer_edge_cases].
-groups() ->
+groups() ->
[{t_string_to_float, [],
[t_string_to_float_safe, t_string_to_float_risky]}].
@@ -73,7 +73,7 @@ t_abs(Config) when is_list(Config) ->
5.5 = abs(id(5.5)),
0.0 = abs(id(0.0)),
100.0 = abs(id(-100.0)),
-
+
%% Integers.
5 = abs(id(5)),
0 = abs(id(0)),
@@ -93,7 +93,7 @@ t_abs(Config) when is_list(Config) ->
BigNum = abs(BigNum),
BigNum = abs(-BigNum),
ok.
-
+
t_float(Config) when is_list(Config) ->
0.0 = float(id(0)),
2.5 = float(id(2.5)),
@@ -109,7 +109,7 @@ t_float(Config) when is_list(Config) ->
%% Extremly big bignums.
Big = id(list_to_integer(id(lists:duplicate(2000, $1)))),
{'EXIT', {badarg, _}} = (catch float(Big)),
-
+
ok.
@@ -183,7 +183,7 @@ t_float_to_string(Config) when is_list(Config) ->
test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]),
test_fts("1.23000000000000000000e+20",1.23e20, []),
ok.
-
+
test_fts(Expect, Float) ->
Expect = float_to_list(Float),
BinExpect = list_to_binary(Expect),
@@ -255,7 +255,7 @@ t_round(Config) when is_list(Config) ->
256 = round(id(255.6)),
-1033 = round(id(-1033.3)),
-1034 = round(id(-1033.6)),
-
+
% OTP-3722:
X = id((1 bsl 27) - 1),
MX = -X,
@@ -345,9 +345,9 @@ t_integer_to_string(Config) when is_list(Config) ->
%% Invalid types
lists:foreach(fun(Value) ->
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:integer_to_binary(Value)),
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:integer_to_list(Value))
end,[atom,1.2,0.0,[$1,[$2]]]),
@@ -416,27 +416,27 @@ t_string_to_integer(Config) when is_list(Config) ->
%% Invalid types
lists:foreach(fun(Value) ->
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch binary_to_integer(Value)),
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:list_to_integer(Value))
end,[atom,1.2,0.0,[$1,[$2]]]),
-
+
% Default base error cases
lists:foreach(fun(Value) ->
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:binary_to_integer(
list_to_binary(Value))),
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:list_to_integer(Value))
end,["1.0"," 1"," -1","","+"]),
-
+
% Custom base error cases
lists:foreach(fun({Value,Base}) ->
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch binary_to_integer(
list_to_binary(Value),Base)),
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:list_to_integer(Value,Base))
end,[{" 1",1},{" 1",37},{"2",2},{"C",11},
{"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16},
@@ -449,10 +449,61 @@ t_string_to_integer(Config) when is_list(Config) ->
ok.
+%% Tests edge cases for list_to_integer; compares with known good values
+
+t_list_to_integer_edge_cases(Config) when is_list(Config) ->
+ %% Take integer literals and compare to their representation in ExtTerm
+ T = [
+ {16, "0", <<131,97,0>>},
+ {16, "-0", <<131,97,0>>},
+
+ {16, "f", <<131,97,15>>},
+ {16, "-f", <<131,98,255,255,255,241>>},
+
+ {16, "0000000000000000000000000000000000000000000000000f",
+ <<131,97,15>>},
+ {16, "-0000000000000000000000000000000000000000000000000f",
+ <<131,98,255,255,255,241>>},
+
+ {16, "ffffffff", <<131,110,4,0,255,255,255,255>>},
+ {16, "-ffffffff", <<131,110,4,1,255,255,255,255>>},
+
+ {16, "7fffffff", <<131,110,4,0,255,255,255,127>>},
+ {16, "-7fffffff", <<131,98,128,0,0,1>>},
+
+ {16, "ffffffffffffffff",
+ <<131,110,8,0,255,255,255,255,255,255,255,255>>},
+ {16, "-ffffffffffffffff",
+ <<131,110,8,1,255,255,255,255,255,255,255,255>>},
+
+ {16, "7fffffffffffffff",
+ <<131,110,8,0,255,255,255,255,255,255,255,127>>},
+ {16, "-7fffffffffffffff",
+ <<131,110,8,1,255,255,255,255,255,255,255,127>>},
+
+ %% Alleged 32-bit corner case (should not happen on 64-bit). At 32-4
+ %% bits we may corrupt sign bit and fall out of SMALL_INT range.
+ {2, "1000000000000000000000000000", <<131,98,8,0,0,0>>},
+ {2, "-1000000000000000000000000000", <<131,98,248,0,0,0>>},
+
+ %% 64-bit corner case (should not happen on 32-bit) at 64-4 bits we
+ %% corrupt sign bit and fall out of SMALL_INT range (bam! all dead)
+ {2, "100000000000000000000000000000000000000000000000000000000000",
+ <<131,110,8,0,0,0,0,0,0,0,0,8>>},
+ {2, "-100000000000000000000000000000000000000000000000000000000000",
+ <<131,110,8,1,0,0,0,0,0,0,0,8>>}
+ ],
+ [begin
+ io:format("~s base ~p vs ~p~n", [Str, Base, Bin]),
+ FromStr = list_to_integer(Str, Base),
+ FromStr = binary_to_term(Bin)
+ end || {Base, Str, Bin} <- T],
+ ok.
+
test_sti(Num) ->
[begin
io:format("Testing ~p:~p",[Num,Base]),
- test_sti(Num,Base)
+ test_sti(Num,Base)
end|| Base <- lists:seq(2,36)].
test_sti(Num,Base) ->
diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl
index 1586a024d8..e714a75954 100644
--- a/erts/emulator/test/old_mod.erl
+++ b/erts/emulator/test/old_mod.erl
@@ -23,7 +23,7 @@
-export([sort_on_old_node/1, sorter/3]).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
sorter(Receiver, Ref, List) ->
Receiver ! {Ref, lists:sort(List)}.
diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl
index 97c99fe07b..272131cb46 100644
--- a/erts/emulator/test/old_scheduler_SUITE.erl
+++ b/erts/emulator/test/old_scheduler_SUITE.erl
@@ -20,7 +20,7 @@
-module(old_scheduler_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl
index 6eda78a57b..4e15b27231 100644
--- a/erts/emulator/test/op_SUITE.erl
+++ b/erts/emulator/test/op_SUITE.erl
@@ -20,7 +20,7 @@
-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,
@@ -97,10 +97,11 @@ relop_simple(Config) when is_list(Config) ->
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)
+ 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.
@@ -158,7 +159,7 @@ cmp_emu(A,B) ->
make_rand_term(1) ->
make_rand_term_single();
make_rand_term(Arity) ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 ->
make_rand_list(Arity);
2 ->
@@ -169,17 +170,17 @@ make_rand_term(Arity) ->
end.
make_rand_term_single() ->
- Range = 1 bsl random:uniform(200),
- case random:uniform(12) of
+ Range = 1 bsl rand:uniform(200),
+ case rand:uniform(12) of
1 -> random;
2 -> uniform;
- 3 -> random:uniform(Range) - (Range div 2);
- 4 -> Range * (random:uniform() - 0.5);
+ 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(random:uniform(Range));
+ 9 -> term_to_binary(rand:uniform(Range));
10 -> fun(X) -> X*Range end;
11 -> fun(X) -> X/Range end;
12 -> []
@@ -188,7 +189,7 @@ make_rand_term_single() ->
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) -> [];
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index 3d0509a28c..5274da301a 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -82,10 +82,11 @@
mul_basic/1, mul_slow_writes/1,
dying_port/1, port_program_with_path/1,
open_input_file_port/1, open_output_file_port/1,
+ count_fds/1,
iter_max_ports/1, eof/1, input_only/1, output_only/1,
name1/1,
t_binary/1, parallell/1, t_exit/1,
- env/1, bad_env/1, cd/1, exit_status/1,
+ env/1, huge_env/1, bad_env/1, cd/1, exit_status/1,
tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1,
otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1,
mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1,
@@ -101,7 +102,7 @@
-export([otp_3906_forker/5, otp_3906_start_forker_starter/4]).
-export([env_slave_main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -111,8 +112,8 @@ all() ->
bad_packet, bad_port_messages, {group, options},
{group, multiple_packets}, parallell, dying_port,
port_program_with_path, open_input_file_port,
- open_output_file_port, name1, env, bad_env, cd,
- exit_status, iter_max_ports, t_exit, {group, tps}, line,
+ open_output_file_port, name1, env, huge_env, bad_env, cd,
+ exit_status, iter_max_ports, count_fds, t_exit, {group, tps}, line,
stderr_to_stdout, otp_3906, otp_4389, win_massive,
mix_up_ports, otp_5112, otp_5119,
exit_status_multi_scheduling_block, ports, spawn_driver,
@@ -385,27 +386,33 @@ input_only(Config) when is_list(Config) ->
output_only(Config) when is_list(Config) ->
Dog = test_server:timetrap(test_server:seconds(100)),
Dir = ?config(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")),
+ 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),
+
test_server:timetrap_cancel(Dog),
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.
@@ -610,6 +617,38 @@ open_output_file_port(Config) when is_list(Config) ->
test_server:timetrap_cancel(Dog),
ok.
+%% Tests that all appropriate fd's have been closed in the port program
+count_fds(suite) -> [];
+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.
@@ -680,7 +719,16 @@ 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)];
@@ -923,6 +971,40 @@ try_bad_env(Env) ->
error:badarg -> ok
end.
+%% Test that we can handle a very very large environment gracefully.
+huge_env(Config) when is_list(Config) ->
+ Vars = case os:type() of
+ {win32,_} -> 500;
+ _ ->
+ %% We create a huge environment,
+ %% 20000 variables is about 25MB
+ %% which seems to be the limit on Linux.
+ 20000
+ end,
+ Env = [{[$a + I div (25*25*25*25) rem 25,
+ $a + I div (25*25*25) rem 25,
+ $a + I div (25*25) rem 25,
+ $a+I div 25 rem 25, $a+I rem 25],
+ lists:duplicate(100,$a+I rem 25)}
+ || I <- lists:seq(1,Vars)],
+ try erlang:open_port({spawn,"ls"},[exit_status, {env, Env}]) of
+ P ->
+ receive
+ {P, {exit_status,N}} = M ->
+ %% We test that the exit status is an integer, this means
+ %% that the child program has started. If we get an atom
+ %% something went wrong in the driver which is not ok.
+ ct:log("Got ~p",[M]),
+ true = is_integer(N)
+ end
+ catch E:R ->
+ %% Have to catch the error here, as printing the stackdump
+ %% in the ct log is way to heavy for some test machines.
+ ct:fail("Open port failed ~p:~p",[E,R])
+ end.
+
+
+
%% 'cd' option
%% (Can perhaps be made smaller by calling the other utility functions
%% in this module.)
@@ -1228,13 +1310,15 @@ otp_4389(Config) when is_list(Config) ->
{P,{exit_status,_}} ->
TCR ! {self(),ok};
{'EXIT',_,{R2,_}} when R2 == emfile;
- R2 == eagain ->
+ R2 == eagain;
+ R2 == enomem ->
TCR ! {self(),ok};
Err2 ->
TCR ! {self(),{msg,Err2}}
end;
{'EXIT',{R1,_}} when R1 == emfile;
- R1 == eagain ->
+ R1 == eagain;
+ R1 == enomem ->
TCR ! {self(),ok};
Err1 ->
TCR ! {self(), {open_port,Err1}}
@@ -1840,10 +1924,12 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) ->
{Prt,
erlang:system_info(scheduler_id)};
{'EXIT', {Err, _}} when Err == eagain;
- Err == emfile ->
+ Err == emfile;
+ Err == enomem ->
noop;
{'EXIT', Err} when Err == eagain;
- Err == emfile ->
+ Err == emfile;
+ Err == enomem ->
noop;
Error ->
?t:fail(Error)
@@ -2183,15 +2269,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);
+ 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, []).
@@ -2331,7 +2416,7 @@ close_deaf_port(Config) when is_list(Config) ->
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!?!?"),
@@ -2372,7 +2457,7 @@ port_setget_data(Config) when is_list(Config) ->
ok.
port_setget_data_hammer(Port, HeapData, IsSet0, N) ->
- Rand = random:uniform(3),
+ Rand = rand:uniform(3),
IsSet1 = try case Rand of
1 -> true = erlang:port_set_data(Port, atom), true;
2 -> true = erlang:port_set_data(Port, HeapData), true;
diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c
index 7abefab2e3..cc3ebdf0f8 100644
--- a/erts/emulator/test/port_SUITE_data/port_test.c
+++ b/erts/emulator/test/port_SUITE_data/port_test.c
@@ -13,6 +13,7 @@
#ifndef __WIN32__
#include <unistd.h>
+#include <limits.h>
#include <sys/time.h>
@@ -48,6 +49,7 @@ typedef struct {
* after reading the header for a packet
* before reading the rest.
*/
+ int fd_count; /* Count the number of open fds */
int break_mode; /* If set, this program will close standard
* input, which should case broken pipe
* error in the writer.
@@ -107,7 +109,7 @@ MAIN(argc, argv)
int argc;
char *argv[];
{
- int ret;
+ int ret, fd_count;
if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) {
fprintf(stderr, "Couldn't malloc for port_data");
exit(1);
@@ -115,6 +117,7 @@ char *argv[];
port_data->header_size = 0;
port_data->io_buf_size = 0;
port_data->delay_mode = 0;
+ port_data->fd_count = 0;
port_data->break_mode = 0;
port_data->quit_mode = 0;
port_data->slow_writes = 0;
@@ -144,6 +147,9 @@ char *argv[];
case 'e':
port_data->fd_to_erl = 2;
break;
+ case 'f':
+ port_data->fd_count = 1;
+ break;
case 'h': /* Header size for packets. */
switch (argv[1][2]) {
case '0': port_data->header_size = 0; break;
@@ -189,18 +195,31 @@ char *argv[];
/* XXX Add error printout here */
}
+ if (port_data->fd_count) {
+#ifdef __WIN32__
+ DWORD handles;
+ GetProcessHandleCount(GetCurrentProcess(), &handles);
+ fd_count = handles;
+#else
+ int i;
+ for (i = 0, fd_count = 0; i < 1024; i++)
+ if (fcntl(i, F_GETFD) >= 0) {
+ fd_count++;
+ }
+#endif
+ }
+
+ if (port_data->output_file)
+ replace_stdout(port_data->output_file);
+
+ if (port_data->fd_count)
+ reply(&fd_count, sizeof(fd_count));
+
if (port_data->no_packet_loop){
free(port_data);
exit(0);
}
- /*
- * If an output file was given, let it replace standard output.
- */
-
- if (port_data->output_file)
- replace_stdout(port_data->output_file);
-
ret = packet_loop();
if(port_data->io_buf_size > 0)
free(port_data->io_buf);
diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl
index b65a22a528..9215d7f720 100644
--- a/erts/emulator/test/port_bif_SUITE.erl
+++ b/erts/emulator/test/port_bif_SUITE.erl
@@ -32,7 +32,7 @@
-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]}].
@@ -485,14 +485,7 @@ random_char(Chars) ->
lists:nth(uniform(length(Chars)), Chars).
uniform(N) ->
- case get(random_seed) of
- undefined ->
- {X, Y, Z} = time(),
- random:seed(X, Y, Z);
- _ ->
- ok
- end,
- random:uniform(N).
+ rand:uniform(N).
unaligned_sub_bin(Bin0) ->
Bin1 = <<0:3,Bin0/binary,31:5>>,
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index 97aa5e573e..862fe78b85 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -26,7 +26,7 @@
%% process_info/1,2
%% register/2 (partially)
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(heap_binary_size, 64).
@@ -41,6 +41,7 @@
process_info_2_list/1, process_info_lock_reschedule/1,
process_info_lock_reschedule2/1,
process_info_lock_reschedule3/1,
+ process_info_garbage_collection/1,
bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1,
process_status_exiting/1,
otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1,
@@ -75,7 +76,9 @@ all() ->
process_info_other_dist_msg, process_info_2_list,
process_info_lock_reschedule,
process_info_lock_reschedule2,
- process_info_lock_reschedule3, process_status_exiting,
+ process_info_lock_reschedule3,
+ process_info_garbage_collection,
+ process_status_exiting,
bump_reductions, low_prio, yield, yield2, otp_4725,
bad_register, garbage_collect, process_info_messages,
process_flag_badarg, process_flag_heap_size,
@@ -932,6 +935,48 @@ start_spawner() ->
stop_spawner() ->
ok.
+%% Tests erlang:process_info(Pid, garbage_collection_info)
+process_info_garbage_collection(_Config) ->
+ Parent = self(),
+ Pid = spawn_link(
+ fun() ->
+ receive go -> ok end,
+ (fun F(0) ->
+ Parent ! deep,
+ receive ok -> ok end,
+ [];
+ F(N) ->
+ timer:sleep(1),
+ [lists:seq(1,100) | F(N-1)]
+ end)(1000),
+ Parent ! shallow,
+ receive done -> ok end
+ end),
+ {garbage_collection_info, Before} =
+ erlang:process_info(Pid, garbage_collection_info),
+ Pid ! go, receive deep -> ok end,
+ {_, Deep} = erlang:process_info(Pid, garbage_collection_info),
+ Pid ! ok, receive shallow -> ok end,
+ {_, After} = erlang:process_info(Pid, garbage_collection_info),
+ Pid ! done,
+
+ %% Do some general checks to see if everything seems to be roughly correct
+ ct:log("Before: ~p",[Before]),
+ ct:log("Deep: ~p",[Deep]),
+ ct:log("After: ~p",[After]),
+
+ %% Check stack_size
+ true = proplists:get_value(stack_size, Before) < proplists:get_value(stack_size, Deep),
+ true = proplists:get_value(stack_size, After) < proplists:get_value(stack_size, Deep),
+
+ %% Check used heap size
+ true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before)
+ < proplists:get_value(heap_size, Deep) + proplists:get_value(old_heap_size, Deep),
+ true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before)
+ < proplists:get_value(heap_size, After) + proplists:get_value(old_heap_size, After),
+
+ ok.
+
%% Tests erlang:bump_reductions/1.
bump_reductions(Config) when is_list(Config) ->
erlang:garbage_collect(),
diff --git a/erts/emulator/test/random_iolist.erl b/erts/emulator/test/random_iolist.erl
index 9a0f034e72..6da7da04de 100644
--- a/erts/emulator/test/random_iolist.erl
+++ b/erts/emulator/test/random_iolist.erl
@@ -36,7 +36,7 @@ run2(Iter,Fun1,Fun2) ->
compare2(Iter,Fun1,Fun2).
random_byte() ->
- random:uniform(256) - 1.
+ rand:uniform(256) - 1.
random_list(0,Acc) ->
Acc;
@@ -45,7 +45,7 @@ random_list(N,Acc) ->
random_binary(N) ->
B = list_to_binary(random_list(N,[])),
- case {random:uniform(2),size(B)} of
+ case {rand:uniform(2),size(B)} of
{2,M} when M > 1 ->
S = M-1,
<<_:3,C:S/binary,_:5>> = B,
@@ -57,7 +57,7 @@ random_list(N) ->
random_list(N,[]).
front() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
10 ->
false;
_ ->
@@ -65,7 +65,7 @@ front() ->
end.
any_type() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
1 ->
list;
2 ->
@@ -77,7 +77,7 @@ any_type() ->
end.
tail_type() ->
- case random:uniform(5) of
+ case rand:uniform(5) of
1 ->
list;
2 ->
@@ -90,9 +90,9 @@ random_length(N) ->
UpperLimit = 255,
case N of
M when M > UpperLimit ->
- random:uniform(UpperLimit+1) - 1;
+ rand:uniform(UpperLimit+1) - 1;
_ ->
- random:uniform(N+1) - 1
+ rand:uniform(N+1) - 1
end.
random_iolist(0,Acc) ->
@@ -139,7 +139,7 @@ random_iolist(N) ->
standard_seed() ->
- random:seed(1201,855653,380975).
+ rand:seed(exsplus, {1201,855653,380975}).
do_comp(List,F1,F2) ->
X = F1(List),
diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl
index ccae0df72e..635c3d27c5 100644
--- a/erts/emulator/test/receive_SUITE.erl
+++ b/erts/emulator/test/receive_SUITE.erl
@@ -22,7 +22,7 @@
%% 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,
diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl
index 1042c23d65..6d4a998094 100644
--- a/erts/emulator/test/ref_SUITE.erl
+++ b/erts/emulator/test/ref_SUITE.erl
@@ -27,7 +27,7 @@
-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)),
diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl
index 5ecca0f547..53bf02e085 100644
--- a/erts/emulator/test/register_SUITE.erl
+++ b/erts/emulator/test/register_SUITE.erl
@@ -23,7 +23,7 @@
%-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,
diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl
index 544d841f16..b40a5f0a56 100644
--- a/erts/emulator/test/save_calls_SUITE.erl
+++ b/erts/emulator/test/save_calls_SUITE.erl
@@ -20,7 +20,7 @@
-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,
@@ -189,7 +189,7 @@ 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 ->
@@ -219,7 +219,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),
diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl
index 986a73ebb1..1f284228db 100644
--- a/erts/emulator/test/scheduler_SUITE.erl
+++ b/erts/emulator/test/scheduler_SUITE.erl
@@ -31,7 +31,7 @@
%-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,
@@ -56,6 +56,7 @@
scheduler_threads/1,
scheduler_suspend/1,
dirty_scheduler_threads/1,
+ dirty_scheduler_exit/1,
reader_groups/1]).
-define(DEFAULT_TIMEOUT, ?t:minutes(15)).
@@ -70,7 +71,7 @@ all() ->
equal_and_high_with_part_time_max, equal_with_high,
equal_with_high_max, bound_process,
{group, scheduler_bind}, scheduler_threads, scheduler_suspend,
- dirty_scheduler_threads,
+ dirty_scheduler_threads, dirty_scheduler_exit,
reader_groups].
groups() ->
@@ -1166,6 +1167,53 @@ get_dsstate(Config, Cmd) ->
stop_node(Node),
{DSCPU, DSCPUOnln, DSIO}.
+dirty_scheduler_exit(Config) when is_list(Config) ->
+ try
+ erlang:system_info(dirty_cpu_schedulers),
+ dirty_scheduler_exit_test(Config)
+ catch
+ error:badarg ->
+ {skipped, "No dirty scheduler support"}
+ end.
+
+dirty_scheduler_exit_test(Config) ->
+ {ok, Node} = start_node(Config, "+SDio 1"),
+ [ok] = mcall(Node,
+ [fun() ->
+ Path = ?config(data_dir, Config),
+ Lib = atom_to_list(?MODULE),
+ ok = erlang:load_nif(filename:join(Path,Lib), []),
+ ok = test_dirty_scheduler_exit()
+ end]),
+ stop_node(Node),
+ ok.
+
+test_dirty_scheduler_exit() ->
+ process_flag(trap_exit,true),
+ test_dse(10,[]).
+test_dse(0,Pids) ->
+ timer:sleep(100),
+ kill_dse(Pids,[]);
+test_dse(N,Pids) ->
+ Pid = spawn_link(fun dirty_sleeper/0),
+ test_dse(N-1,[Pid|Pids]).
+kill_dse([],Killed) ->
+ wait_dse(Killed);
+kill_dse([Pid|Pids],AlreadyKilled) ->
+ exit(Pid,kill),
+ kill_dse(Pids,[Pid|AlreadyKilled]).
+wait_dse([]) ->
+ ok;
+wait_dse([Pid|Pids]) ->
+ receive
+ {'EXIT',Pid,killed} ->
+ ok
+ end,
+ wait_dse(Pids).
+
+dirty_sleeper() ->
+ erlang:nif_error({error,?MODULE}).
+
scheduler_suspend(Config) when is_list(Config) ->
?line Dog = ?t:timetrap(?t:minutes(5)),
?line lists:foreach(fun (S) -> scheduler_suspend_test(Config, S) end,
diff --git a/erts/emulator/test/scheduler_SUITE_data/Makefile.src b/erts/emulator/test/scheduler_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..859112cf19
--- /dev/null
+++ b/erts/emulator/test/scheduler_SUITE_data/Makefile.src
@@ -0,0 +1,8 @@
+
+SCHEDULER_LIBS = scheduler_SUITE@dll@
+
+all: $(SCHEDULER_LIBS)
+
+@SHLIB_RULES@
+
+$(SCHEDULER_LIBS): scheduler_SUITE.c
diff --git a/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c
new file mode 100644
index 0000000000..022858c114
--- /dev/null
+++ b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c
@@ -0,0 +1,31 @@
+#include <unistd.h>
+#include "erl_nif.h"
+
+static int
+load(ErlNifEnv* env, void** priv, ERL_NIF_TERM info)
+{
+ ErlNifSysInfo sys_info;
+ enif_system_info(&sys_info, sizeof(ErlNifSysInfo));
+ if (!sys_info.smp_support || !sys_info.dirty_scheduler_support)
+ return 1;
+ return 0;
+}
+
+static ERL_NIF_TERM
+dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
+ sleep(3);
+#endif
+ return enif_make_atom(env, "ok");
+}
+
+static ErlNifFunc funcs[] = {
+#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
+ {"dirty_sleeper", 0, dirty_sleeper, ERL_NIF_DIRTY_JOB_IO_BOUND}
+#else
+ {"dirty_sleeper", 0, dirty_sleeper, 0}
+#endif
+};
+
+ERL_NIF_INIT(scheduler_SUITE, funcs, &load, NULL, NULL, NULL);
diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl
index 670865cd3f..63c11519b8 100644
--- a/erts/emulator/test/send_term_SUITE.erl
+++ b/erts/emulator/test/send_term_SUITE.erl
@@ -26,7 +26,7 @@
-export([generate_external_terms_files/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(3)),
diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl
index 2e51712737..29517cdcb8 100644
--- a/erts/emulator/test/sensitive_SUITE.erl
+++ b/erts/emulator/test/sensitive_SUITE.erl
@@ -20,7 +20,7 @@
-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,
diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl
index 4aa690fb0f..e176fe52d6 100644
--- a/erts/emulator/test/signal_SUITE.erl
+++ b/erts/emulator/test/signal_SUITE.erl
@@ -31,7 +31,7 @@
-define(DEFAULT_TIMEOUT_SECONDS, 120).
%-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]).
diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl
index 5bb98e5ad9..2df19cd20b 100644
--- a/erts/emulator/test/smoke_test_SUITE.erl
+++ b/erts/emulator/test/smoke_test_SUITE.erl
@@ -20,7 +20,7 @@
-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,
diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl
index a6305d453c..df96b018a1 100644
--- a/erts/emulator/test/statistics_SUITE.erl
+++ b/erts/emulator/test/statistics_SUITE.erl
@@ -32,13 +32,13 @@
run_queue_one/1,
scheduler_wall_time/1,
reductions/1, reductions_big/1, garbage_collection/1, io/1,
- badarg/1, run_queues_lengths_active_tasks/1]).
+ badarg/1, run_queues_lengths_active_tasks/1, msacc/1]).
%% Internal exports.
-export([hog/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(_, Config) ->
?line Dog = test_server:timetrap(test_server:seconds(300)),
@@ -55,7 +55,8 @@ all() ->
[{group, wall_clock}, {group, runtime}, reductions,
reductions_big, {group, run_queue}, scheduler_wall_time,
garbage_collection, io, badarg,
- run_queues_lengths_active_tasks].
+ run_queues_lengths_active_tasks,
+ msacc].
groups() ->
[{wall_clock, [],
@@ -470,3 +471,114 @@ run_queues_lengths_active_tasks(Config) ->
TokLoops),
ok.
+
+msacc(doc) ->
+ "Tests that statistics(microstate_statistics) works.";
+msacc(Config) ->
+
+ %% Test if crypto nif is available
+ Niff = try crypto:strong_rand_bytes(1), ok catch _:_ -> nok end,
+ TmpFile = filename:join(proplists:get_value(priv_dir,Config),"file.tmp"),
+
+ false = erlang:system_flag(microstate_accounting, true),
+
+ msacc_test(TmpFile),
+
+ true = erlang:system_flag(microstate_accounting, false),
+
+ MsaccStats = erlang:statistics(microstate_accounting),
+
+ case os:type() of
+ {win32, _} ->
+ %% Some windows have a very poor accuracy on their
+ %% timing primitives, so we just make sure that
+ %% some state besides sleep has been triggered.
+ Sum = lists:sum(
+ lists:map(fun({sleep, _V}) -> 0;
+ ({_, V}) -> V
+ end, maps:to_list(msacc_sum_states()))
+ ),
+ if Sum > 0 ->
+ ok;
+ true ->
+ ct:fail({no_states_triggered, MsaccStats})
+ end;
+ _ ->
+
+ %% Make sure that all states were triggered at least once
+ maps:map(fun(nif, 0) ->
+ case Niff of
+ ok ->
+ ct:fail({zero_state,nif});
+ nok ->
+ ok
+ end;
+ (aux, 0) ->
+ %% aux will be zero if we do not have smp support
+ %% or no async threads
+ case erlang:system_info(smp_support) orelse
+ erlang:system_info(thread_pool_size) > 0
+ of
+ false ->
+ ok;
+ true ->
+ ct:log("msacc: ~p",[MsaccStats]),
+ ct:fail({zero_state,aux})
+ end;
+ (Key, 0) ->
+ ct:log("msacc: ~p",[MsaccStats]),
+ ct:fail({zero_state,Key});
+ (_,_) -> ok
+ end, msacc_sum_states())
+ end,
+
+ erlang:system_flag(microstate_accounting, reset),
+
+ msacc_test(TmpFile),
+
+ %% Make sure all counters are zero after stopping and resetting
+ maps:map(fun(_Key, 0) -> ok;
+ (Key,_) ->
+ ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]),
+ ct:fail({non_zero_state,Key})
+ end,msacc_sum_states()).
+
+%% This test tries to make sure to trigger all of the different available states
+msacc_test(TmpFile) ->
+
+ %% We write some data
+ [file:write_file(TmpFile,<<0:(1024*1024*8)>>,[raw]) || _ <- lists:seq(1,100)],
+
+ %% Do some ETS operations
+ Tid = ets:new(table, []),
+ ets:insert(Tid, {1, hello}),
+ ets:delete(Tid),
+
+ %% Collect some garbage
+ [erlang:garbage_collect() || _ <- lists:seq(1,100)],
+
+ %% Send some messages
+ [begin self() ! {hello},receive _ -> ok end end || _ <- lists:seq(1,100)],
+
+ %% Setup some timers
+ Refs = [erlang:send_after(10000,self(),ok) || _ <- lists:seq(1,100)],
+
+ %% Do some nif work
+ catch [crypto:strong_rand_bytes(128) || _ <- lists:seq(1,100)],
+
+ %% Cancel some timers
+ [erlang:cancel_timer(R) || R <- Refs],
+
+ %% Wait for a while
+ timer:sleep(100).
+
+msacc_sum_states() ->
+ Stats = erlang:statistics(microstate_accounting),
+ [#{ counters := C }|_] = Stats,
+ InitialCounters = maps:map(fun(_,_) -> 0 end,C),
+ lists:foldl(fun(#{ counters := Counters }, Cnt) ->
+ maps:fold(fun(Key, Value, Acc) ->
+ NewValue = Value+maps:get(Key,Acc),
+ maps:update(Key, NewValue, Acc)
+ end, Cnt, Counters)
+ end,InitialCounters,Stats).
diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl
index bee42c07d9..ae18b280cf 100644
--- a/erts/emulator/test/system_info_SUITE.erl
+++ b/erts/emulator/test/system_info_SUITE.erl
@@ -31,7 +31,7 @@
%-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,
@@ -185,8 +185,6 @@ wordsize(Config) when is_list(Config) ->
{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.
diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl
index 2ecb4a28a7..c63a119f9d 100644
--- a/erts/emulator/test/system_profile_SUITE.erl
+++ b/erts/emulator/test/system_profile_SUITE.erl
@@ -37,7 +37,7 @@
-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)).
@@ -534,7 +534,7 @@ 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,
diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl
index 787870588d..f6f99a0c81 100644
--- a/erts/emulator/test/time_SUITE.erl
+++ b/erts/emulator/test/time_SUITE.erl
@@ -48,7 +48,7 @@
-export([local_to_univ_utc/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([linear_time/1]).
@@ -69,7 +69,7 @@
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
[{testcase, Func}|Config].
-end_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, _Config) ->
ok.
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -776,25 +776,21 @@ chk_strc(Res0, Res1) ->
ok.
chk_random_values(FR, TR) ->
-% case (FR rem TR == 0) orelse (TR rem FR == 0) of
-% true ->
- io:format("rand values ~p -> ~p~n", [FR, TR]),
- random:seed(268438039, 268440479, 268439161),
- Values = lists:map(fun (_) -> random:uniform(1 bsl 65) - (1 bsl 64) end,
- lists:seq(1, 100000)),
- CheckFun = fun (V) ->
- CV = erlang:convert_time_unit(V, FR, TR),
- case {(FR*CV) div TR =< V,
- (FR*(CV+1)) div TR >= V} of
- {true, true} ->
- ok;
- Failure ->
- ?t:fail({Failure, CV, V, FR, TR})
- end
- end,
- lists:foreach(CheckFun, Values).%;
-% false -> ok
-% end.
+ io:format("rand values ~p -> ~p~n", [FR, TR]),
+ rand:seed(exsplus, {268438039,268440479,268439161}),
+ Values = lists:map(fun (_) -> rand:uniform(1 bsl 65) - (1 bsl 64) end,
+ lists:seq(1, 100000)),
+ CheckFun = fun (V) ->
+ CV = erlang:convert_time_unit(V, FR, TR),
+ case {(FR*CV) div TR =< V,
+ (FR*(CV+1)) div TR >= V} of
+ {true, true} ->
+ ok;
+ Failure ->
+ ?t:fail({Failure, CV, V, FR, TR})
+ end
+ end,
+ lists:foreach(CheckFun, Values).
chk_values_per_value(_FromRes, _ToRes,
diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl
index 51d59f09f3..f4615d6810 100644
--- a/erts/emulator/test/timer_bif_SUITE.erl
+++ b/erts/emulator/test/timer_bif_SUITE.erl
@@ -33,7 +33,7 @@
% same_time_yielding_with_cancel_other_accessor/1,
auto_cancel_yielding/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(SHORT_TIMEOUT, 5000). %% Bif timers as short as this may be pre-allocated
-define(TIMEOUT_YIELD_LIMIT, 100).
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index 6eae182e45..02c2c7a93a 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -38,7 +38,7 @@
system_monitor_long_schedule/1,
bad_flag/1, trace_delivered/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%% Internal exports
-export([process/1]).
@@ -933,7 +933,7 @@ 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),
+ rand:seed(exsplus, {4711,17,4711}),
?line do_suspend_exit(5000),
?line test_server:timetrap_cancel(Dog),
?line ok.
@@ -941,7 +941,7 @@ suspend_exit(Config) when is_list(Config) ->
do_suspend_exit(0) ->
?line ok;
do_suspend_exit(N) ->
- ?line Work = random:uniform(50),
+ Work = rand:uniform(50),
?line Parent = self(),
?line {Suspendee, Mon2}
= spawn_monitor(fun () ->
diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl
index 96b7dd159f..ae98cc7189 100644
--- a/erts/emulator/test/trace_bif_SUITE.erl
+++ b/erts/emulator/test/trace_bif_SUITE.erl
@@ -20,7 +20,7 @@
-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]).
diff --git a/erts/emulator/test/trace_call_count_SUITE.erl b/erts/emulator/test/trace_call_count_SUITE.erl
index c7881bbd70..e358791f1f 100644
--- a/erts/emulator/test/trace_call_count_SUITE.erl
+++ b/erts/emulator/test/trace_call_count_SUITE.erl
@@ -43,7 +43,7 @@
-define(config(A,B),config(A,B)).
-export([config/2]).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-endif.
-ifdef(debug).
diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl
index f359e1bd80..a802aa12b8 100644
--- a/erts/emulator/test/trace_call_time_SUITE.erl
+++ b/erts/emulator/test/trace_call_time_SUITE.erl
@@ -58,7 +58,7 @@
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--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,
diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl
index 7431099340..503a773545 100644
--- a/erts/emulator/test/trace_local_SUITE.erl
+++ b/erts/emulator/test/trace_local_SUITE.erl
@@ -46,7 +46,7 @@
-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.
diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl
index 3b105ec6fe..8f732f0a5f 100644
--- a/erts/emulator/test/trace_meta_SUITE.erl
+++ b/erts/emulator/test/trace_meta_SUITE.erl
@@ -46,7 +46,7 @@
-define(config(A,B),config(A,B)).
-export([config/2]).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-endif.
-ifdef(debug).
diff --git a/erts/emulator/test/trace_nif_SUITE.erl b/erts/emulator/test/trace_nif_SUITE.erl
index 1cd50350e3..3ac891b1dd 100644
--- a/erts/emulator/test/trace_nif_SUITE.erl
+++ b/erts/emulator/test/trace_nif_SUITE.erl
@@ -20,7 +20,7 @@
-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]).
diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl
index a77710205e..b169a264be 100644
--- a/erts/emulator/test/trace_port_SUITE.erl
+++ b/erts/emulator/test/trace_port_SUITE.erl
@@ -38,7 +38,7 @@
default_tracer/1,
tracer_port_crash/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
test_cases() ->
[call_trace, return_trace, send, receive_trace,
diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl
index f1f077be6b..2c2f93e7ee 100644
--- a/erts/emulator/test/tuple_SUITE.erl
+++ b/erts/emulator/test/tuple_SUITE.erl
@@ -26,7 +26,7 @@
t_make_tuple_2/1, t_make_upper_boundry_tuple_2/1, t_make_tuple_3/1,
t_append_element/1, t_append_element_upper_boundry/1,
build_and_match/1, tuple_with_case/1, tuple_in_guard/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Tests tuples and the BIFs:
%%
diff --git a/erts/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl
index 6fa634b886..bbbcf3fa2a 100644
--- a/erts/emulator/test/unique_SUITE.erl
+++ b/erts/emulator/test/unique_SUITE.erl
@@ -26,7 +26,7 @@
-export([unique_monotonic_integer_white_box/1,
unique_integer_white_box/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%-define(P(V), V).
-define(P(V), print_ret_val(?FILE, ?LINE, V)).
@@ -267,10 +267,21 @@ calc_sched_bits(NoScheds, Shift) when NoScheds < 1 bsl Shift ->
calc_sched_bits(NoScheds, Shift) ->
calc_sched_bits(NoScheds, Shift+1).
+schedulers() ->
+ S = erlang:system_info(schedulers),
+ try
+ DCPUS = erlang:system_info(dirty_cpu_schedulers),
+ DIOS = erlang:system_info(dirty_io_schedulers),
+ S+DCPUS+DIOS
+ catch
+ _ : _ ->
+ S
+ end.
+
init_uniqint_info() ->
SmallBits = erlang:system_info({wordsize, internal})*8-4,
io:format("SmallBits=~p~n", [SmallBits]),
- Schedulers = erlang:system_info(schedulers),
+ Schedulers = schedulers(),
io:format("Schedulers=~p~n", [Schedulers]),
MinSmall = -1*(1 bsl (SmallBits-1)),
io:format("MinSmall=~p~n", [MinSmall]),
@@ -337,7 +348,7 @@ check_uniqint(Int, UinqintInfo) ->
true ->
io:format("OK~n~n", []);
false ->
- io:format("result UniqInt=~p FAILED~n", [UniqInt]),
+ io:format("result Int=~p FAILED~n", [Int]),
exit(badres)
end.
diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl
index f4d9030255..0037a9a477 100644
--- a/erts/emulator/test/z_SUITE.erl
+++ b/erts/emulator/test/z_SUITE.erl
@@ -30,7 +30,7 @@
%-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,
@@ -249,6 +249,7 @@ pollset_size(Config) when is_list(Config) ->
?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),
+ HasGethost = case has_gethost() of true -> 1; _ -> 0 end,
?line case InitPollsetSize =:= FinPollsetSize of
true ->
case InitPollsetSize of
@@ -269,7 +270,7 @@ pollset_size(Config) when is_list(Config) ->
= InitPollsetSize,
?line {value, {total_poll_set_size, FinSize}}
= FinPollsetSize,
- ?line true = FinSize < InitSize,
+ ?line true = FinSize < (InitSize + HasGethost),
?line true = 2 =< FinSize,
?line {comment,
"Start pollset size: "
@@ -289,16 +290,39 @@ check_io_debug(Config) when is_list(Config) ->
end.
check_io_debug_test() ->
- ?line erlang:display(get_check_io_info()),
- ?line erts_debug:set_internal_state(available_internal_state, true),
- ?line {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs}
+ erlang:display(get_check_io_info()),
+ erts_debug:set_internal_state(available_internal_state, true),
+ {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug
= erts_debug:get_internal_state(check_io_debug),
- ?line erts_debug:set_internal_state(available_internal_state, false),
- ?line 0 = NoErrorFds,
- ?line NoUsedFds = NoDrvSelStructs,
+ 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,
?line 0 = NoDrvEvStructs,
?line 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.
%%
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index 9a8c3585e6..f805e7cc64 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -48,12 +48,17 @@ $pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize
'(3*BEAM_LOOSE_SHIFT)'];
$pack_mask[2] = ['BEAM_LOOSE_MASK', $WHOLE_WORD];
-$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK'];
+$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD];
$pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize
'BEAM_LOOSE_MASK',
'BEAM_LOOSE_MASK',
$WHOLE_WORD];
+# Mapping from packagable arguments to number of packed arguments per
+# word. Initialized after the wordsize is known.
+
+my @args_per_word;
+
# There are two types of instructions: generic and specific.
# The generic instructions are those generated by the Beam compiler.
# Corresponding to each generic instruction, there is generally a
@@ -176,11 +181,12 @@ sub define_type_bit {
}
# Composed types.
- define_type_bit('d', $type_bit{'x'} | $type_bit{'y'} | $type_bit{'r'});
+ define_type_bit('d', $type_bit{'x'} | $type_bit{'y'});
define_type_bit('c', $type_bit{'i'} | $type_bit{'a'} |
$type_bit{'n'} | $type_bit{'q'});
define_type_bit('s', $type_bit{'d'} | $type_bit{'i'} |
- $type_bit{'a'} | $type_bit{'n'});
+ $type_bit{'a'} | $type_bit{'n'} |
+ $type_bit{'q'});
define_type_bit('j', $type_bit{'f'} | $type_bit{'p'});
# Aliases (for matching purposes).
@@ -236,6 +242,20 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) {
}
#
+# Initialize number of arguments per packed word.
+#
+
+$args_per_word[2] = 2;
+$args_per_word[3] = 3;
+$args_per_word[4] = 2;
+$args_per_word[5] = 3;
+$args_per_word[6] = 3;
+
+if ($wordsize == 64) {
+ $args_per_word[4] = 4;
+}
+
+#
# Parse the input files.
#
@@ -527,12 +547,16 @@ sub emulator_output {
my(@bits) = (0) x ($max_spec_operands/2);
my($i);
+ my $involves_r = 0;
for ($i = 0; $i < $max_spec_operands && defined $args[$i]; $i++) {
my $t = $args[$i];
- if (defined $type_bit{$t}) {
- my $shift = $max_genop_types * ($i % 2);
- $bits[int($i/2)] |= $type_bit{$t} << $shift;
+ my $bits = $type_bit{$t};
+ if ($t eq 'r') {
+ $bits |= $type_bit{'x'};
+ $involves_r |= 1 << $i;
}
+ my $shift = $max_genop_types * ($i % 2);
+ $bits[int($i/2)] |= $bits << $shift;
}
printf "/* %3d */ ", $spec_opnum;
@@ -544,7 +568,7 @@ sub emulator_output {
$sep = ",";
}
$init .= "}";
- &init_item($print_name, $init, $size, $pack, $sign, 0);
+ init_item($print_name, $init, $involves_r, $size, $pack, $sign, 0);
$op_to_name[$spec_opnum] = $instr;
$spec_opnum++;
}
@@ -601,15 +625,12 @@ sub emulator_output {
print "#define MAX_GENERIC_OPCODE ", $num_file_opcodes-1, "\n";
print "#define NUM_GENERIC_OPS ", scalar(@gen_opname), "\n";
print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n";
+ print "#define SCRATCH_X_REG 1023\n";
print "\n";
print "#ifdef ARCH_64\n";
print "# define BEAM_WIDE_MASK 0xFFFFUL\n";
- print "# define BEAM_LOOSE_MASK 0x1FFFUL\n";
- print "#if HALFWORD_HEAP\n";
- print "# define BEAM_TIGHT_MASK 0x1FFCUL\n";
- print "#else\n";
- print "# define BEAM_TIGHT_MASK 0x1FF8UL\n";
- print "#endif\n";
+ print "# define BEAM_LOOSE_MASK 0xFFFFUL\n";
+ print "# define BEAM_TIGHT_MASK 0xFFFFUL\n";
print "# define BEAM_WIDE_SHIFT 32\n";
print "# define BEAM_LOOSE_SHIFT 16\n";
print "# define BEAM_TIGHT_SHIFT 16\n";
@@ -734,7 +755,7 @@ sub init_item {
print "${sep}NULL";
} elsif (/^\{/) {
print "$sep$_";
- } elsif (/^-?\d/) {
+ } elsif (/^-?\d+$/) {
print "$sep$_";
} else {
print "$sep\"$_\"";
@@ -896,6 +917,7 @@ sub basic_generator {
my($var_decls) = '';
my($gen_dest_arg) = 'StoreSimpleDest';
my($i);
+ my($no_prefetch) = 0;
# The following argument types should be included as macro arguments.
my(%incl_arg) = ('c' => 1,
@@ -994,6 +1016,7 @@ sub basic_generator {
#
$flags =~ /-fail_action/ and do {
+ $no_prefetch = 1;
if (!defined $fail_type) {
my($i);
for ($i = 0; $i < @f_types; $i++) {
@@ -1040,6 +1063,12 @@ sub basic_generator {
"I += $size + 1;",
"goto $goto;",
"}");
+ } elsif ($no_prefetch) {
+ $code = join("\n",
+ "{ $var_decls",
+ $macro_code,
+ "Next($size);",
+ "}", "");
} else {
$code = join("\n",
"{ $var_decls",
@@ -1061,6 +1090,7 @@ sub do_pack {
my($packable_args) = 0;
my @is_packable; # Packability (boolean) for each argument.
my $wide_packing = 0;
+ my(@orig_args) = @args;
#
# Count the number of packable arguments. If we encounter any 's' or 'd'
@@ -1081,6 +1111,18 @@ sub do_pack {
}
} elsif ($arg =~ /^[sd]/) {
return ('', '', @args);
+ } elsif ($arg =~ /^[scq]/ and $packable_args > 0) {
+ # When packing, this operand will be picked up from the
+ # code array, put onto the packing stack, and later put
+ # back into a different location in the code. The problem
+ # is that if this operand is a literal, the original
+ # location in the code would have been remembered in a
+ # literal patch. For packing to work, we would have to
+ # adjust the position in the literal patch. For the
+ # moment, adding additional instructions to the packing
+ # engine to handle this does not seem worth it, so we will
+ # just turn off packing.
+ return ('', '', @args);
} else {
push @is_packable, 0;
}
@@ -1090,7 +1132,6 @@ sub do_pack {
# Get out of here if too few or too many arguments.
#
return ('', '', @args) if $packable_args < 2;
- &error("too many packable arguments") if $packable_args > 4;
my($size) = 0;
my($pack_prefix) = '';
@@ -1098,14 +1139,8 @@ sub do_pack {
# beginning).
my($up) = ''; # Pack commands (storing back while
# moving forward).
- my $args_per_word;
- if ($packable_args < 4 or $wordsize == 64) {
- $args_per_word = $packable_args;
- } else {
- # 4 packable argument, 32 bit wordsize. Need 2 words.
- $args_per_word = 2;
- }
+ my $args_per_word = $args_per_word[$packable_args];
my @shift;
my @mask;
my @instr;
@@ -1299,6 +1334,8 @@ sub tr_parse_op {
foreach (split('', $type)) {
&error("bad type in $op")
unless defined $type_bit{$_} or $type eq '*';
+ $_ eq 'r' and
+ error("$op: 'r' is not allowed in transformations")
}
}
@@ -1332,7 +1369,10 @@ sub tr_parse_op {
}
# Get an optional value. (In destination.)
+ $type_val = $type eq 'x' ? 1023 : 0;
if (/^=(.*)/) {
+ error("value not allowed in source: $op")
+ if $src;
$type_val = $1;
$_ = '';
}
@@ -1351,11 +1391,6 @@ sub tr_parse_op {
if $var && $type;
}
- # Test that source has no values.
- if ($src) {
- error("value not allowed in source: $op")
- if $type_val;
- }
($var,$type,$type_val,$cond,$cond_val);
}
diff --git a/erts/emulator/valgrind/suppress.halfword b/erts/emulator/valgrind/suppress.halfword
deleted file mode 100644
index 8fe448d897..0000000000
--- a/erts/emulator/valgrind/suppress.halfword
+++ /dev/null
@@ -1,56 +0,0 @@
-# Extra suppressions specific for the halfword emulator.
-
-# --- Suppress all offheap binaries ---
-# Valgrinds leak check does not recognize pointers that are stored
-# at unaligned addresses. In halfword emulator we store 64-bit pointers
-# to offheap data on 32-bit aligned heaps.
-# We solve this by suppressing allocation of all offheap structures
-# that are not referenced by other tables (ie binaries).
-
-{
-Halfword erts_bin_nrml_alloc
-Memcheck:Leak
-...
-fun:erts_bin_nrml_alloc
-...
-}
-
-{
-Halfword erts_bin_realloc
-Memcheck:Leak
-...
-fun:erts_bin_realloc
-...
-}
-
-{
-Halfword erts_bin_realloc_fnf
-Memcheck:Leak
-...
-fun:erts_bin_realloc_fnf
-...
-}
-
-{
-Halfword erts_bin_drv_alloc
-Memcheck:Leak
-...
-fun:erts_bin_drv_alloc
-...
-}
-
-{
-Halfword erts_bin_drv_alloc_fnf
-Memcheck:Leak
-...
-fun:erts_bin_drv_alloc_fnf
-...
-}
-
-{
-Halfword erts_create_magic_binary
-Memcheck:Leak
-...
-fun:erts_create_magic_binary
-...
-}
diff --git a/erts/epmd/src/Makefile.in b/erts/epmd/src/Makefile.in
index b6e3ba7762..1266be44cb 100644
--- a/erts/epmd/src/Makefile.in
+++ b/erts/epmd/src/Makefile.in
@@ -19,10 +19,6 @@
#
include $(ERL_TOP)/make/target.mk
-ifeq ($(findstring ose,$(TARGET)),ose)
-include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk
-endif
-
ifeq ($(TYPE),debug)
PURIFY =
TYPEMARKER = .debug
@@ -32,21 +28,13 @@ else
ifeq ($(TYPE),purify)
PURIFY = purify
TYPEMARKER =
-ifeq ($(findstring ose,$(TARGET)),ose)
- TYPE_FLAGS = -DPURIFY
-else
- TYPE_FLAGS = -O2 -DPURIFY
-endif
+TYPE_FLAGS = -O2 -DPURIFY
else
override TYPE = opt
PURIFY =
TYPEMARKER =
-ifeq ($(findstring ose,$(TARGET)),ose)
- TYPE_FLAGS =
-else
- TYPE_FLAGS = -O2
-endif
+TYPE_FLAGS = -O2
endif
endif
@@ -68,13 +56,9 @@ else
ifeq ($(findstring vxworks,$(TARGET)),vxworks)
ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@
-else
ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ -lm
endif
endif
-endif
ERTS_LIB = $(ERL_TOP)/erts/lib_src/obj/$(TARGET)/$(TYPE)/MADE
@@ -82,11 +66,7 @@ CC = @CC@
WFLAGS = @WFLAGS@
CFLAGS = @CFLAGS@ @DEFS@ $(TYPE_FLAGS) $(WFLAGS) $(ERTS_INCL)
LD = @LD@
-ifeq ($(findstring ose,$(TARGET)),ose)
-LIBS = $(ERTS_INTERNAL_LIBS) @LIBS@
-else
LIBS = @LIBS@ @SYSTEMD_DAEMON_LIBS@ $(ERTS_INTERNAL_LIBS)
-endif
LDFLAGS = @LDFLAGS@
@@ -135,25 +115,12 @@ clean:
rm -f *.o
rm -f *~ core
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(OBJDIR)/ose_confd.o: $(OSE_CONFD)
- $(V_CC) $(CFLAGS) -o $@ -c $<
-$(OBJDIR)/crt0_lm.o: $(CRT0_LM)
- $(V_CC) $(CFLAGS) -o $@ -c $<
-OSE_LM_OBJS += $(OBJDIR)/ose_confd.o $(OBJDIR)/crt0_lm.o
-endif
-
#
# Objects & executables
#
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(BINDIR)/$(EPMD): $(EPMD_OBJS) $(ERTS_LIB) $(OSE_LM_OBJS)
- $(call build-ose-load-module, $@, $(EPMD_OBJS) $(OSE_LM_OBJS), $(LIBS), $(EPMD_LMCONF))
-else
$(BINDIR)/$(EPMD): $(EPMD_OBJS) $(ERTS_LIB)
$(ld_verbose)$(PURIFY) $(LD) $(LDFLAGS) -o $@ $(EPMD_OBJS) $(LIBS)
-endif
$(OBJDIR)/%.o: %.c epmd.h epmd_int.h
$(V_CC) $(CFLAGS) $(EPMD_FLAGS) -o $@ -c $<
diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c
index 63ec18d939..21ce4e52b0 100644
--- a/erts/epmd/src/epmd.c
+++ b/erts/epmd/src/epmd.c
@@ -397,7 +397,7 @@ static void run_daemon(EpmdVars *g)
}
#endif
-#if defined(VXWORKS) || defined(__OSE__)
+#if defined(VXWORKS)
static void run_daemon(EpmdVars *g)
{
run(g);
diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h
index 26100afc93..e222abb4b7 100644
--- a/erts/epmd/src/epmd_int.h
+++ b/erts/epmd/src/epmd_int.h
@@ -37,13 +37,6 @@
#define DONT_USE_MAIN
#endif
-#ifdef __OSE__
-# define NO_DAEMON
-# define NO_SYSLOG
-# define NO_SYSCONF
-# define NO_FCNTL
-#endif
-
/* ************************************************************************ */
/* Standard includes */
@@ -100,12 +93,7 @@
#endif /* ! WIN32 */
#include <ctype.h>
-
-#if !defined(__OSE__)
-# include <signal.h>
-#endif
-
-
+#include <signal.h>
#include <errno.h>
#ifdef HAVE_SYSLOG_H
@@ -122,10 +110,6 @@
#include <stdarg.h>
-#ifdef __OSE__
-# include "sys/select.h"
-#endif
-
#ifdef HAVE_SYSTEMD_DAEMON
# include <systemd/sd-daemon.h>
#endif /* HAVE_SYSTEMD_DAEMON */
diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c
index 7100855407..fb8cae05df 100644
--- a/erts/epmd/src/epmd_srv.c
+++ b/erts/epmd/src/epmd_srv.c
@@ -30,11 +30,6 @@
# define INADDR_NONE 0xffffffff
#endif
-#if defined(__OSE__)
-# include "sys/ioctl.h"
-# define sleep(x) delay(x*1000)
-#endif
-
/*
*
* This server is a local name server for Erlang nodes. Erlang nodes can
@@ -315,7 +310,7 @@ void run(EpmdVars *g)
}
#endif /* HAVE_SYSTEMD_DAEMON */
-#if !defined(__WIN32__) && !defined(__OSE__)
+#if !defined(__WIN32__)
/* We ignore the SIGPIPE signal that is raised when we call write
twice on a socket closed by the other end. */
signal(SIGPIPE, SIG_IGN);
diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl
index 4de65500e9..0c8f01ef6b 100644
--- a/erts/epmd/test/epmd_SUITE.erl
+++ b/erts/epmd/test/epmd_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(epmd_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in
index 8e55fa78c9..05d925f19f 100644
--- a/erts/etc/common/Makefile.in
+++ b/erts/etc/common/Makefile.in
@@ -21,10 +21,6 @@
include $(ERL_TOP)/make/output.mk
include $(ERL_TOP)/make/target.mk
-ifeq ($(findstring ose,$(TARGET)),ose)
-include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk
-endif
-
ERTS_LIB_TYPEMARKER=.$(TYPE)
USING_MINGW=@MIXED_CYGWIN_MINGW@
@@ -85,18 +81,13 @@ EMUOSDIR = $(ERL_TOP)/erts/emulator/@ERLANG_OSTYPE@
SYSDIR = $(ERL_TOP)/erts/emulator/sys/@ERLANG_OSTYPE@
DRVDIR = $(ERL_TOP)/erts/emulator/drivers/@ERLANG_OSTYPE@
UXETC = ../unix
-OSEETC = ../ose
WINETC = ../win32
ifeq ($(TARGET), win32)
ETC = $(WINETC)
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-ETC = $(OSEETC)
-else
ETC = $(UXETC)
endif
-endif
ifeq ($(TARGET), win32)
ERLEXEC = erlexec.dll
@@ -180,25 +171,6 @@ PORT_ENTRY_POINT=erl_port_entry
ENTRY_LDFLAGS=-entry:$(PORT_ENTRY_POINT)
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-ENTRY_LDFLAGS=
-ENTRY_OBJ=
-ERLSRV_OBJECTS=
-MC_OUTPUTS=
-INET_GETHOST =
-INSTALL_EMBEDDED_PROGS = $(BINDIR)/run_erl_lm
-INSTALL_EMBEDDED_DATA =
-INSTALL_TOP = Install
-INSTALL_TOP_BIN =
-INSTALL_MISC =
-INSTALL_SRC =
-ERLEXECDIR = .
-INSTALL_LIBS =
-INSTALL_OBJS =
-INSTALL_INCLUDES =
-TEXTFILES = Install erl.src
-INSTALL_PROGS = $(INSTALL_EMBEDDED_PROGS)
-else # UNIX (!win32 && !ose)
ENTRY_LDFLAGS=
ENTRY_OBJ=
ERLSRV_OBJECTS=
@@ -223,7 +195,6 @@ INSTALL_PROGS = \
$(BINDIR)/$(ERLEXEC) \
$(INSTALL_EMBEDDED_PROGS)
endif
-endif
.PHONY: etc
etc: $(ENTRY_OBJ) $(INSTALL_PROGS) $(INSTALL_LIBS) $(TEXTFILES) $(INSTALL_TOP_BIN)
@@ -269,8 +240,8 @@ endif
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/dyn_erl.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/safe_string.o
- rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/run_erl_common.o
- rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl_common.o
+ rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/run_erl.o
+ rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/typer.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/ct_run.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/vxcall.o
@@ -423,28 +394,24 @@ $(BINDIR)/inet_gethost@EXEEXT@: $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(ERTS_LIB
$(ld_verbose)$(PURIFY) $(LD) $(LDFLAGS) $(ENTRY_LDFLAGS) -o $@ $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(LIBS) $(ERTS_INTERNAL_LIBS)
# run_erl
-$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(OBJDIR)/run_erl_common.o
- $(V_LD) $(LDFLAGS) -o $@ $^ $(LIBS)
-$(OBJDIR)/run_erl.o: $(ETC)/run_erl.c ../common/run_erl_common.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(ETC)/run_erl.c
-$(OBJDIR)/run_erl_common.o: ../common/run_erl_common.c ../common/run_erl_common.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -o $@ -c $<
+$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o
+ $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(LIBS)
+$(OBJDIR)/run_erl.o: $(ETC)/run_erl.c $(RC_GENERATED)
+ $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/run_erl.c
# to_erl
-$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o $(OBJDIR)/to_erl_common.o
- $(V_LD) $(LDFLAGS) -o $@ $^
-$(OBJDIR)/to_erl.o: $(ETC)/to_erl.c ../common/safe_string.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(ETC)/to_erl.c
-$(OBJDIR)/to_erl_common.o: ../common/to_erl_common.c ../common/to_erl_common.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -o $@ -c $<
+$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o
+ $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o
+$(OBJDIR)/to_erl.o: $(ETC)/to_erl.c $(RC_GENERATED)
+ $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/to_erl.c
# dyn_erl
$(BINDIR)/dyn_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o
$(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o
$(OBJDIR)/dyn_erl.o: $(UXETC)/dyn_erl.c $(RC_GENERATED)
$(V_CC) $(CFLAGS) -o $@ -c $(UXETC)/dyn_erl.c
-$(OBJDIR)/safe_string.o: ../common/safe_string.c $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -o $@ -c ../common/safe_string.c
+$(OBJDIR)/safe_string.o: $(ETC)/safe_string.c $(RC_GENERATED)
+ $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/safe_string.c
ifneq ($(TARGET),win32)
$(BINDIR)/$(ERLEXEC): $(OBJDIR)/$(ERLEXEC).o $(ERTS_LIB)
@@ -499,30 +466,6 @@ erl.src: $(UXETC)/erl.src.src ../../vsn.mk $(TARGET)/Makefile
-e 's;%VSN%;$(VSN);' \
$(UXETC)/erl.src.src > erl.src
-#---------------------------------------------------------
-# OSE specific targets
-#---------------------------------------------------------
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(OBJDIR)/ose_confd.o: $(OSE_CONFD)
- $(V_CC) $(CFLAGS) -o $@ -c $<
-$(OBJDIR)/crt0_lm.o: $(CRT0_LM)
- $(V_CC) $(CFLAGS) -o $@ -c $<
-OSE_LM_OBJS += $(OBJDIR)/ose_confd.o $(OBJDIR)/crt0_lm.o
-
-$(BINDIR)/run_erl_lm: $(OBJDIR)/run_erl_main.o $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(OBJDIR)/run_erl_common.o $(OBJDIR)/to_erl_common.o $(OSE_LM_OBJS)
- $(call build-ose-load-module, $@, $^, $(LIBS), $(RUN_ERL_LMCONF))
-
-
-$(OBJDIR)/run_erl_main.o: $(OSEETC)/run_erl_main.c $(OSEETC)/run_erl.h ../common/to_erl_common.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(OSEETC)/run_erl_main.c
-
-endif
-
-#---------------------------------------------------------
-# End of ose specific targets.
-#---------------------------------------------------------
-
-
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
@@ -537,11 +480,9 @@ endif
$(INSTALL_DIR) "$(RELEASE_PATH)/erts-$(VSN)/bin"
ifneq ($(TARGET), win32)
ifneq ($(findstring vxworks,$(TARGET)), vxworks)
-ifneq ($(findstring ose,$(TARGET)), ose)
$(INSTALL_SCRIPT) erl.src "$(RELEASE_PATH)/erts-$(VSN)/bin"
endif
endif
-endif
ifneq ($(INSTALL_PROGS),)
$(INSTALL_PROGRAM) $(INSTALL_PROGS) "$(RELEASE_PATH)/erts-$(VSN)/bin"
endif
diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c
index af1c198281..f21671e837 100644
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -156,6 +156,12 @@ static char *plusr_val_switches[] = {
NULL
};
+/* +x arguments with values */
+static char *plusx_val_switches[] = {
+ "mqd",
+ NULL
+};
+
/* +z arguments with values */
static char *plusz_val_switches[] = {
"dbbl",
@@ -976,6 +982,20 @@ int main(int argc, char **argv)
add_Eargs(argv[i+1]);
i++;
break;
+ case 'x':
+ if (!is_one_of_strings(&argv[i][2], plusx_val_switches)) {
+ goto the_default;
+ } else {
+ if (i+1 >= argc
+ || argv[i+1][0] == '-'
+ || argv[i+1][0] == '+')
+ usage(argv[i]);
+ argv[i][0] = '-';
+ add_Eargs(argv[i]);
+ add_Eargs(argv[i+1]);
+ i++;
+ }
+ break;
case 'z':
if (!is_one_of_strings(&argv[i][2], plusz_val_switches)) {
goto the_default;
@@ -1176,7 +1196,7 @@ usage_aux(void)
"[+S NO_SCHEDULERS:NO_SCHEDULERS_ONLINE] "
"[+SP PERCENTAGE_SCHEDULERS:PERCENTAGE_SCHEDULERS_ONLINE] "
"[+T LEVEL] [+V] [+v] "
- "[+W<i|w|e>] [+z MISC_OPTION] [args ...]\n");
+ "[+W<i|w|e>] [+x DEFAULT_PROC_FLAGS] [+z MISC_OPTION] [args ...]\n");
exit(1);
}
diff --git a/erts/etc/common/run_erl_common.c b/erts/etc/common/run_erl_common.c
deleted file mode 100644
index c03d5e3ae2..0000000000
--- a/erts/etc/common/run_erl_common.c
+++ /dev/null
@@ -1,696 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2014. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include <dirent.h>
-#include <errno.h>
-#include <fcntl.h>
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <sys/stat.h>
-#include <sys/types.h>
-#include <time.h>
-#include <unistd.h>
-
-#ifdef __ANDROID__
-# include <termios.h>
-#endif
-
-#ifdef HAVE_SYSLOG_H
-# include <syslog.h>
-#endif
-
-#ifdef HAVE_SYS_IOCTL_H
-# include <sys/ioctl.h>
-#endif
-
-#ifdef __OSE__
-# include "ramlog.h"
-#endif
-
-#include "run_erl_common.h"
-#include "safe_string.h"
-
-#define DEFAULT_LOG_GENERATIONS 5
-#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */
-#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */
-#define DEFAULT_LOG_MAXSIZE 100000
-#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */
-#define LOG_STUBNAME "erlang.log."
-#define LOG_PERM 0664
-#define DEFAULT_LOG_ACTIVITY_MINUTES 5
-#define DEFAULT_LOG_ALIVE_MINUTES 15
-#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y"
-#define ALIVE_BUFFSIZ 1024
-
-#define STATUSFILENAME "/run_erl.log"
-
-#define PIPE_STUBNAME "erlang.pipe"
-#define PIPE_STUBLEN strlen(PIPE_STUBNAME)
-#define PERM (S_IWUSR | S_IRUSR | S_IWOTH | S_IROTH | S_IWGRP | S_IRGRP)
-
-/* OSE has defined O_SYNC but it is not recognized by open */
-#if !defined(O_SYNC) || defined(__OSE__)
-#undef O_SYNC
-#define O_SYNC 0
-#define USE_FSYNC 1
-#endif
-
-/* Global variable definitions
- * We need this complex way of handling global variables because of how
- * OSE works here. We want to make it possible to run the shell command
- * run_erl multiple times with different global variables without them
- * effecting eachother.
- */
-
-#define STATUSFILE (RE_DATA->statusfile)
-#define LOG_DIR (RE_DATA->log_dir)
-#define STDSTATUS (RE_DATA->stdstatus)
-#define LOG_GENERATIONS (RE_DATA->log_generations)
-#define LOG_MAXSIZE (RE_DATA->log_maxsize)
-#define LOG_ACTIVITY_MINUTES (RE_DATA->log_activity_minutes)
-#define LOG_ALIVE_IN_GMT (RE_DATA->log_alive_in_gmt)
-#define LOG_ALIVE_FORMAT (RE_DATA->log_alive_format)
-#define RUN_DAEMON (RE_DATA->run_daemon)
-#define LOG_ALIVE_MINUTES (RE_DATA->log_alive_minutes)
-#define LOG_NUM (RE_DATA->log_num)
-#define LFD (RE_DATA->lfd)
-#define PROTOCOL_VER (RE_DATA->protocol_ver)
-
-struct run_erl_ {
- /* constant config data */
- char statusfile[FILENAME_BUFSIZ];
- char log_dir[FILENAME_BUFSIZ];
- FILE *stdstatus;
- int log_generations;
- int log_maxsize;
- int log_activity_minutes;
- int log_alive_in_gmt;
- char log_alive_format[ALIVE_BUFFSIZ+1];
- int run_daemon;
- int log_alive_minutes;
- /* Current log number and log fd */
- int log_num;
- int lfd;
- unsigned protocol_ver;
-};
-
-typedef struct run_erl_ run_erl;
-
-#ifdef __OSE__
-static OSPPDKEY run_erl_pp_key;
-#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key))
-#else
-static run_erl re;
-#define RE_DATA (&re)
-#endif
-
-/* prototypes */
-
-static int next_log(int log_num);
-static int prev_log(int log_num);
-static int find_next_log_num(void);
-static int open_log(int log_num, int flags);
-
-/*
- * getenv_int:
- */
-static char *getenv_int(const char *name) {
-#ifdef __OSE__
- return get_env(get_bid(current_process()),name);
-#else
- return getenv(name);
-#endif
-}
-
-/*
- * next_log:
- * Returns the index number that follows the given index number.
- * (Wrapping after log_generations)
- */
-static int next_log(int log_num) {
- return log_num>=LOG_GENERATIONS?1:log_num+1;
-}
-
-/*
- * prev_log:
- * Returns the index number that precedes the given index number.
- * (Wrapping after log_generations)
- */
-static int prev_log(int log_num) {
- return log_num<=1?LOG_GENERATIONS:log_num-1;
-}
-
-/*
- * find_next_log_num()
- * Searches through the log directory to check which logs that already
- * exist. It finds the "hole" in the sequence, and returns the index
- * number for the last log in the log sequence. If there is no hole, index
- * 1 is returned.
- */
-static int find_next_log_num(void) {
- int i, next_gen, log_gen;
- DIR *dirp;
- struct dirent *direntp;
- int log_exists[LOG_MAX_GENERATIONS+1];
- int stub_len = strlen(LOG_STUBNAME);
-
- /* Initialize exiting log table */
-
- for(i=LOG_GENERATIONS; i>=0; i--)
- log_exists[i] = 0;
- dirp = opendir(LOG_DIR);
- if(!dirp) {
- ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", LOG_DIR);
- exit(1);
- }
-
- /* Check the directory for existing logs */
-
- while((direntp=readdir(dirp)) != NULL) {
- if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) {
- int num = atoi(direntp->d_name+stub_len);
- if(num < 1 || num > LOG_GENERATIONS)
- continue;
- log_exists[num] = 1;
- }
- }
- closedir(dirp);
-
- /* Find out the next available log file number */
-
- next_gen = 0;
- for(i=LOG_GENERATIONS; i>=0; i--) {
- if(log_exists[i])
- if(next_gen)
- break;
- else
- ;
- else
- next_gen = i;
- }
-
- /* Find out the current log file number */
-
- if(next_gen)
- log_gen = prev_log(next_gen);
- else
- log_gen = 1;
-
- return log_gen;
-} /* find_next_log_num() */
-
-static int open_log(int log_num, int flags)
-{
- char buf[FILENAME_MAX];
- time_t now;
- struct tm *tmptr;
- char log_buffer[ALIVE_BUFFSIZ+1];
-
- /* Remove the next log (to keep a "hole" in the log sequence) */
- sn_printf(buf, sizeof(buf), "%s/%s%d",
- LOG_DIR, LOG_STUBNAME, next_log(log_num));
- unlink(buf);
-
- /* Create or continue on the current log file */
- sn_printf(buf, sizeof(buf), "%s/%s%d", LOG_DIR, LOG_STUBNAME, log_num);
-
- LFD = sf_open(buf, flags, LOG_PERM);
-
- if(LFD <0){
- ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf);
- exit(1);
- }
-
- /* Write a LOGGING STARTED and time stamp into the log file */
- time(&now);
- if (LOG_ALIVE_IN_GMT) {
- tmptr = gmtime(&now);
- } else {
- tmptr = localtime(&now);
- }
- if (!strftime(log_buffer, ALIVE_BUFFSIZ, LOG_ALIVE_FORMAT,
- tmptr)) {
- strn_cpy(log_buffer, sizeof(log_buffer),
- "(could not format time in 256 positions "
- "with current format string.)");
- }
- log_buffer[ALIVE_BUFFSIZ] = '\0';
-
- sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n",
- log_buffer);
- if (erts_run_erl_write_all(LFD, buf, strlen(buf)) < 0)
- erts_run_erl_log_status("Error in writing to log.\n");
-
-#if USE_FSYNC
- fsync(LFD);
-#endif
-
- return LFD;
-}
-
-/* Instead of making sure basename exists, we do our own */
-char *simple_basename(char *path)
-{
- char *ptr;
- for (ptr = path; *ptr != '\0'; ++ptr) {
- if (*ptr == '/') {
- path = ptr + 1;
- }
- }
- return path;
-}
-
-ssize_t sf_read(int fd, void *buffer, size_t len) {
- ssize_t n = 0;
-
- do { n = read(fd, buffer, len); } while (n < 0 && errno == EINTR);
-
- return n;
-}
-
-ssize_t sf_write(int fd, const void *buffer, size_t len) {
- ssize_t n = 0;
-
- do { n = write(fd, buffer, len); } while (n < 0 && errno == EINTR);
-
- return n;
-}
-
-int sf_open(const char *path, int type, mode_t mode) {
- int fd = 0;
-
- do { fd = open(path, type, mode); } while(fd < 0 && errno == EINTR);
-
- return fd;
-}
-
-int sf_close(int fd) {
- int res = 0;
-
- do { res = close(fd); } while(res < 0 && errno == EINTR);
-
- return res;
-}
-
-/* Call write() until entire buffer has been written or error.
- * Return len or -1.
- */
-int erts_run_erl_write_all(int fd, const char* buf, int len)
-{
- int left = len;
- int written;
- for (;;) {
- do {
- written = write(fd,buf,left);
- } while (written < 0 && errno == EINTR);
- if (written == left) {
- return len;
- }
- if (written < 0) {
- return -1;
- }
- left -= written;
- buf += written;
- }
- return written;
-}
-
-/* erts_run_erl_log_status()
- * Prints the arguments to a status file
- * Works like printf (see vfrpintf)
- */
-void erts_run_erl_log_status(const char *format,...)
-{
- va_list args;
- time_t now;
-
- if (STDSTATUS == NULL)
- STDSTATUS = fopen(STATUSFILE, "w");
- if (STDSTATUS == NULL)
- return;
- now = time(NULL);
- fprintf(STDSTATUS, "run_erl [%d] %s",
-#ifdef __OSE__
- (int)current_process(),
-#else
- (int)getpid(),
-#endif
- ctime(&now));
- va_start(args, format);
- vfprintf(STDSTATUS, format, args);
- va_end(args);
- fflush(STDSTATUS);
- return;
-}
-
-/* Fetch the current log alive minutes */
-int erts_run_erl_log_alive_minutes() {
- return LOG_ALIVE_MINUTES;
-}
-
-/* error_logf()
- * Prints the arguments to stderr or syslog
- * Works like printf (see vfprintf)
- */
-void erts_run_erl_log_error(int priority, int line, const char *format, ...)
-{
- va_list args;
- va_start(args, format);
-
-#ifdef HAVE_SYSLOG_H
- if (RUN_DAEMON) {
- vsyslog(priority,format,args);
- }
- else
-#endif
-#ifdef __OSE__
- if (RUN_DAEMON) {
- char *buff = malloc(sizeof(char)*1024);
- vsnprintf(buff,1024,format, args);
- ramlog_printf(buff);
- }
- else
-#endif
- {
- time_t now = time(NULL);
- fprintf(stderr, "run_erl:%d [%d] %s", line,
-#ifdef __OSE__
- (int)current_process(),
-#else
- (int)getpid(),
-#endif
- ctime(&now));
- vfprintf(stderr, format, args);
- }
- va_end(args);
-}
-
-/* erts_run_erl_log_write()
- * Writes a message to lfd. If the current log file is full,
- * a new log file is opened.
- */
-int erts_run_erl_log_write(char* buf, size_t len)
-{
- int size;
- ssize_t res;
- /* Decide if new logfile needed, and open if so */
-
- size = lseek(LFD,0,SEEK_END);
- if(size+len > LOG_MAXSIZE) {
- int res;
- do {
- res = close(LFD);
- } while (res < 0 && errno == EINTR);
- LOG_NUM = next_log(LOG_NUM);
- LFD = open_log(LOG_NUM, O_RDWR|O_CREAT|O_TRUNC|O_SYNC);
- }
-
- /* Write to log file */
-
- if ((res = erts_run_erl_write_all(LFD, buf, len)) < 0) {
- erts_run_erl_log_status("Error in writing to log.\n");
- }
-
-#if USE_FSYNC
- fsync(LFD);
-#endif
- return res;
-}
-
-int erts_run_erl_log_activity(int timeout,time_t now,time_t last_activity) {
- char log_alive_buffer[ALIVE_BUFFSIZ+1];
- char buf[BUFSIZ];
-
- if (timeout || now - last_activity > LOG_ACTIVITY_MINUTES*60) {
- /* Either a time out: 15 minutes without action, */
- /* or something is coming in right now, but it's a long time */
- /* since last time, so let's write a time stamp this message */
- struct tm *tmptr;
- if (LOG_ALIVE_IN_GMT) {
- tmptr = gmtime(&now);
- } else {
- tmptr = localtime(&now);
- }
- if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, LOG_ALIVE_FORMAT,
- tmptr)) {
- strn_cpy(log_alive_buffer, sizeof(log_alive_buffer),
- "(could not format time in 256 positions "
- "with current format string.)");
- }
- log_alive_buffer[ALIVE_BUFFSIZ] = '\0';
-
- sn_printf(buf, sizeof(buf), "\n===== %s%s\n",
- timeout?"ALIVE ":"", log_alive_buffer);
- return erts_run_erl_log_write(buf, strlen(buf));
- }
- return 0;
-}
-
-int erts_run_erl_log_open() {
-
- LOG_NUM = find_next_log_num();
- LFD = open_log(LOG_NUM, O_RDWR|O_APPEND|O_CREAT|O_SYNC);
- return 0;
-}
-
-int erts_run_erl_log_init(int daemon, char* logdir) {
- char *p;
-
-#ifdef __OSE__
- run_erl **re_pp;
- if (!run_erl_pp_key)
- ose_create_ppdata("run_erl_ppdata",&run_erl_pp_key);
- re_pp = (run_erl **)ose_get_ppdata(run_erl_pp_key);
- *re_pp = malloc(sizeof(run_erl));
-#endif
-
- STDSTATUS = NULL;
- LOG_GENERATIONS = DEFAULT_LOG_GENERATIONS;
- LOG_MAXSIZE = DEFAULT_LOG_MAXSIZE;
- LOG_ACTIVITY_MINUTES = DEFAULT_LOG_ACTIVITY_MINUTES;
- LOG_ALIVE_IN_GMT = 0;
- RUN_DAEMON = 0;
- LOG_ALIVE_MINUTES = DEFAULT_LOG_ALIVE_MINUTES;
- LFD = 0;
- PROTOCOL_VER = RUN_ERL_LO_VER; /* assume lowest to begin with */
-
- /* Get values for LOG file handling from the environment */
- if ((p = getenv_int("RUN_ERL_LOG_ALIVE_MINUTES"))) {
- LOG_ALIVE_MINUTES = atoi(p);
- if (!LOG_ALIVE_MINUTES) {
- ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 "
- "(current value is %s)",p);
- }
- LOG_ACTIVITY_MINUTES = LOG_ALIVE_MINUTES / 3;
- if (!LOG_ACTIVITY_MINUTES) {
- ++LOG_ACTIVITY_MINUTES;
- }
- }
- if ((p = getenv_int(
- "RUN_ERL_LOG_ACTIVITY_MINUTES"))) {
- LOG_ACTIVITY_MINUTES = atoi(p);
- if (!LOG_ACTIVITY_MINUTES) {
- ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 "
- "(current value is %s)",p);
- }
- }
- if ((p = getenv_int("RUN_ERL_LOG_ALIVE_FORMAT"))) {
- if (strlen(p) > ALIVE_BUFFSIZ) {
- ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of "
- "%d characters", ALIVE_BUFFSIZ);
- }
- strn_cpy(LOG_ALIVE_FORMAT, sizeof(LOG_ALIVE_FORMAT), p);
- } else {
- strn_cpy(LOG_ALIVE_FORMAT, sizeof(LOG_ALIVE_FORMAT),
- DEFAULT_LOG_ALIVE_FORMAT);
- }
- if ((p = getenv_int("RUN_ERL_LOG_ALIVE_IN_UTC"))
- && strcmp(p,"0")) {
- ++LOG_ALIVE_IN_GMT;
- }
- if ((p = getenv_int("RUN_ERL_LOG_GENERATIONS"))) {
- LOG_GENERATIONS = atoi(p);
- if (LOG_GENERATIONS < LOG_MIN_GENERATIONS)
- ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d",
- LOG_MIN_GENERATIONS);
- if (LOG_GENERATIONS > LOG_MAX_GENERATIONS)
- ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d",
- LOG_MAX_GENERATIONS);
- }
-
- if ((p = getenv_int("RUN_ERL_LOG_MAXSIZE"))) {
- LOG_MAXSIZE = atoi(p);
- if (LOG_MAXSIZE < LOG_MIN_MAXSIZE)
- ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE);
- }
-
- RUN_DAEMON = daemon;
-
- strn_cpy(LOG_DIR, sizeof(LOG_DIR), logdir);
- strn_cpy(STATUSFILE, sizeof(STATUSFILE), LOG_DIR);
- strn_cat(STATUSFILE, sizeof(STATUSFILE), STATUSFILENAME);
-
- return 0;
-}
-
-/* create_fifo()
- * Creates a new fifo with the given name and permission.
- */
-static int create_fifo(char *name, int perm)
-{
- if ((mkfifo(name, perm) < 0) && (errno != EEXIST))
- return -1;
- return 0;
-}
-
-/*
- * w- and r_pipename have to be pre-allocated of atleast FILENAME_MAX size
- */
-int erts_run_erl_open_fifo(char *pipename,char *w_pipename,char *r_pipename) {
- int calculated_pipename = 0;
- int highest_pipe_num = 0;
- int fd;
-
- /*
- * Create FIFOs and open them
- */
-
- if(*pipename && pipename[strlen(pipename)-1] == '/') {
- /* The user wishes us to find a unique pipe name in the specified */
- /* directory */
- DIR *dirp;
- struct dirent *direntp;
-
- calculated_pipename = 1;
- dirp = opendir(pipename);
- if(!dirp) {
- ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename);
- return 1;
- }
-
- /* Check the directory for existing pipes */
-
- while((direntp=readdir(dirp)) != NULL) {
- if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) {
- int num = atoi(direntp->d_name+PIPE_STUBLEN+1);
- if(num > highest_pipe_num)
- highest_pipe_num = num;
- }
- }
- closedir(dirp);
- strn_catf(pipename, BUFSIZ, "%s.%d",
- PIPE_STUBNAME, highest_pipe_num+1);
- } /* if */
-
- for(;;) {
- /* write FIFO - is read FIFO for `to_erl' program */
- strn_cpy(w_pipename, BUFSIZ, pipename);
- strn_cat(w_pipename, BUFSIZ, ".r");
- if (create_fifo(w_pipename, PERM) < 0) {
- ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.",
- w_pipename);
- return 1;
- }
-
- /* read FIFO - is write FIFO for `to_erl' program */
- strn_cpy(r_pipename, BUFSIZ, pipename);
- strn_cat(r_pipename, BUFSIZ, ".w");
-
- /* Check that nobody is running run_erl already */
- if ((fd = sf_open(r_pipename, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) {
- /* Open as client succeeded -- run_erl is already running! */
- sf_close(fd);
- if (calculated_pipename) {
- ++highest_pipe_num;
- strn_catf(pipename, BUFSIZ, "%s.%d",
- PIPE_STUBNAME, highest_pipe_num+1);
- continue;
- }
- ERROR1(LOG_ERR, "Erlang already running on pipe %s.\n", pipename);
- unlink(w_pipename);
- return 1;
- }
- if (create_fifo(r_pipename, PERM) < 0) {
- unlink(w_pipename);
- ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.",
- r_pipename);
- return 1;
- }
- break;
- }
- return 0;
-}
-
-/* Extract any control sequences that are ment only for run_erl
- * and should not be forwarded to the pty.
- */
-int erts_run_erl_extract_ctrl_seq(char* buf, int len, int mfd)
-{
- static const char prefix[] = "\033_";
- static const char suffix[] = "\033\\";
- char* bufend = buf + len;
- char* start = buf;
- char* command;
- char* end;
-
- for (;;) {
- start = find_str(start, bufend-start, prefix);
- if (!start) break;
-
- command = start + strlen(prefix);
- end = find_str(command, bufend-command, suffix);
- if (end) {
- unsigned col, row;
- if (sscanf(command,"version=%u", &PROTOCOL_VER)==1) {
- /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/
- }
- else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) {
-#ifdef TIOCSWINSZ
- struct winsize ws;
- ws.ws_col = col;
- ws.ws_row = row;
- if (ioctl(mfd, TIOCSWINSZ, &ws) < 0) {
- ERRNO_ERR0(LOG_ERR,"Failed to set window size");
- }
-#endif
- }
- else {
- ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n",
- (int)(end-command), command);
- }
-
- /* Remove ctrl sequence from buf */
- end += strlen(suffix);
- memmove(start, end, bufend-end);
- bufend -= end - start;
- }
- else {
- ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n",
- (int)(bufend-start), start);
- break;
- }
- }
- return bufend - buf;
-}
diff --git a/erts/etc/common/run_erl_common.h b/erts/etc/common/run_erl_common.h
deleted file mode 100644
index cecf7521f9..0000000000
--- a/erts/etc/common/run_erl_common.h
+++ /dev/null
@@ -1,97 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Functions that are common to both OSE and unix implementations of run_erl
- */
-#ifndef ERL_RUN_ERL_LOG_H
-#define ERL_RUN_ERL_LOG_H
-
-#include <stdio.h>
-#include <time.h>
-#include <unistd.h>
-
-#include "run_erl_vsn.h"
-
-/* Log handling */
-int erts_run_erl_log_init(int run_daemon, char* logdir);
-int erts_run_erl_log_open(void);
-int erts_run_erl_log_close(void);
-int erts_run_erl_log_write(char *buff, size_t len);
-int erts_run_erl_log_activity(int timeout, time_t now, time_t last_activity);
-
-void erts_run_erl_log_status(const char *format,...);
-void erts_run_erl_log_error(int priority, int line, const char *format,...);
-
-int erts_run_erl_open_fifo(char *pipename,char *w_pipename,char *r_pipename);
-int erts_run_erl_log_alive_minutes(void);
-int erts_run_erl_extract_ctrl_seq(char* buf, int len, int mfd);
-
-/* File operations */
-ssize_t sf_read(int fd, void *buffer, size_t len);
-ssize_t sf_write(int fd, const void *buffer, size_t len);
-int sf_open(const char *path, int type, mode_t mode);
-int sf_close(int fd);
-int erts_run_erl_write_all(int fd, const char* buf, int len);
-char *simple_basename(char *path);
-
-#ifndef LOG_ERR
-#ifdef __OSE__
-#define LOG_ERR 0
-#else
-#define LOG_ERR NULL
-#endif
-#endif
-
-#define ERROR0(Prio,Format) erts_run_erl_log_error(Prio,__LINE__,Format"\n")
-#define ERROR1(Prio,Format,A1) erts_run_erl_log_error(Prio,__LINE__,Format"\n",A1)
-#define ERROR2(Prio,Format,A1,A2) erts_run_erl_log_error(Prio,__LINE__,Format"\n",A1,A2)
-
-#ifdef HAVE_STRERROR
-# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno)
-#else
-# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno
-#endif
-#define ERRNO_ERR0(Prio,Format) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format))
-#define ERRNO_ERR1(Prio,Format,A1) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format),A1)
-#define ERRNO_ERR2(Prio,Format,A1,A2) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format),A1,A2)
-
-#define RUN_ERL_USAGE \
- "%s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"" \
- "\n\nDESCRIPTION:\n" \
- "You may also set the environment variables RUN_ERL_LOG_GENERATIONS\n" \
- "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n" \
- "size of the log file when to switch to the next log file\n"
-
-#ifndef FILENAME_MAX
-#define FILENAME_MAX 250
-#endif
-
-#define FILENAME_BUFSIZ FILENAME_MAX
-
-#ifdef O_NONBLOCK
-# define DONT_BLOCK_PLEASE O_NONBLOCK
-#else
-# define DONT_BLOCK_PLEASE O_NDELAY
-# ifndef EAGAIN
-# define EAGAIN -3898734
-# endif
-#endif
-
-#endif
diff --git a/erts/etc/common/to_erl_common.c b/erts/etc/common/to_erl_common.c
deleted file mode 100644
index 8aa94ccfa4..0000000000
--- a/erts/etc/common/to_erl_common.c
+++ /dev/null
@@ -1,717 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Module: to_erl.c
- *
- * This module implements a process that opens two specified FIFOs, one
- * for reading and one for writing; reads from its stdin, and writes what
- * it has read to the write FIF0; reads from the read FIFO, and writes to
- * its stdout.
- *
- ________ _________
- | |--<-- pipe.r (fifo1) --<--| |
- | to_erl | | run_erl | (parent)
- |________|-->-- pipe.w (fifo2) -->--|_________|
- ^ master pty
- |
- | slave pty
- ____V____
- | |
- | "erl" | (child)
- |_________|
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <sys/time.h>
-#include <sys/types.h>
-#include <fcntl.h>
-#include <unistd.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <dirent.h>
-#include <errno.h>
-
-#ifdef __OSE__
-#include <aio.h>
-#include "ose.h"
-#include "efs.h"
-#include "ose_spi/fm.sig"
-#else /* __UNIX__ */
-#include <termios.h>
-#include <signal.h>
-#endif
-
-#ifdef HAVE_SYS_IOCTL_H
-# include <sys/ioctl.h>
-#endif
-
-#include "to_erl_common.h"
-#include "run_erl_vsn.h"
-#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */
-
-#if defined(O_NONBLOCK)
-# define DONT_BLOCK_PLEASE O_NONBLOCK
-#else
-# define DONT_BLOCK_PLEASE O_NDELAY
-# if !defined(EAGAIN)
-# define EAGAIN -3898734
-# endif
-#endif
-
-#ifdef HAVE_STRERROR
-# define STRERROR(x) strerror(x)
-#else
-# define STRERROR(x) ""
-#endif
-
-#define noDEBUG
-
-#ifdef __OSE__
-#define PIPE_DIR "/pipe/"
-#else
-#define PIPE_DIR "/tmp/"
-#endif
-#define PIPE_STUBNAME "erlang.pipe"
-#define PIPE_STUBLEN strlen(PIPE_STUBNAME)
-
-#ifdef DEBUG
-#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); }
-#else
-#define STATUS(s)
-#endif
-
-#ifndef FILENAME_MAX
-#define FILENAME_MAX 250
-#endif
-
-static int tty_eof = 0;
-static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */
-
-static int write_all(int fd, const char* buf, int len);
-static int version_handshake(char* buf, int len, int wfd);
-
-
-#ifdef __OSE__
-
-#define SET_AIO(REQ,FD,SIZE,BUFF) \
- /* Make sure to clean data structure of previous request */ \
- memset(&(REQ),0,sizeof(REQ)); \
- (REQ).aio_fildes = FD; \
- (REQ).aio_offset = FM_POSITION_CURRENT; \
- (REQ).aio_nbytes = SIZE; \
- (REQ).aio_buf = BUFF; \
- (REQ).aio_sigevent.sigev_notify = SIGEV_NONE
-
-#define READ_AIO(REQ,FD,SIZE,BUFF) \
- SET_AIO(REQ,FD,SIZE,BUFF); \
- if (aio_read(&(REQ)) != 0) \
- fprintf(stderr,"aio_read of child_read_req(%d) failed" \
- "with error %d\n",FD,errno)
-
-union SIGNAL {
- SIGSELECT signo;
- struct FmReadPtr fm_read_ptr;
-};
-
-#else /* __UNIX__ */
-static int recv_sig = 0;
-static struct termios tty_smode, tty_rmode;
-static int window_size_seq(char* buf, size_t bufsz);
-#ifdef DEBUG
-static void show_terminal_settings(struct termios *);
-#endif
-
-static void handle_ctrlc(int sig)
-{
- /* Reinstall the handler, and signal break flag */
- signal(SIGINT,handle_ctrlc);
- recv_sig = SIGINT;
-}
-
-static void handle_sigwinch(int sig)
-{
- recv_sig = SIGWINCH;
-}
-#endif
-
-static void usage(char *pname)
-{
- fprintf(stderr, "Usage: ");
- fprintf(stderr,TO_ERL_USAGE,pname);
-}
-
-int to_erl(int argc, char **argv)
-{
- char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX];
- int i, len, wfd, rfd;
- char pipename[FILENAME_MAX];
- int pipeIx = 1;
- int force_lock = 0;
- int got_some = 0;
-
-#ifdef __OSE__
- struct aiocb stdin_read_req, pipe_read_req;
- FmHandle stdin_fh, pipe_fh;
- char *stdin_buf, *pipe_buf;
- char *buf;
- union SIGNAL *sig;
-#else /* __UNIX__ */
- char buf[BUFSIZ];
- fd_set readfds;
-#endif
-
- if (argc >= 2 && argv[1][0]=='-') {
- switch (argv[1][1]) {
- case 'h':
- usage(argv[0]);
- exit(1);
- case 'F':
- force_lock = 1;
- break;
- default:
- fprintf(stderr,"Invalid option '%s'\n",argv[1]);
- exit(1);
- }
- pipeIx = 2;
- }
-
-#ifdef DEBUG
- fprintf(stderr, "%s: pid is : %d\n", argv[0],(int)
-#ifdef __OSE__
- current_process()
-#else /* __UNIX__ */
- getpid()
-#endif
- );
-#endif
-
- strn_cpy(pipename, sizeof(pipename),
- (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR));
-
- if(*pipename && pipename[strlen(pipename)-1] == '/') {
- /* The user wishes us to find a pipe name in the specified */
- /* directory */
- int highest_pipe_num = 0;
- DIR *dirp;
- struct dirent *direntp;
-
- dirp = opendir(pipename);
- if(!dirp) {
- fprintf(stderr, "Can't access pipe directory %s: %s\n", pipename, strerror(errno));
- exit(1);
- }
-
- /* Check the directory for existing pipes */
-
- while((direntp=readdir(dirp)) != NULL) {
- if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) {
- int num = atoi(direntp->d_name+PIPE_STUBLEN+1);
- if(num > highest_pipe_num)
- highest_pipe_num = num;
- }
- }
- closedir(dirp);
- strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"),
- PIPE_STUBNAME, highest_pipe_num);
- } /* if */
-
- /* read FIFO */
- sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename);
- /* write FIFO */
- sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename);
-
-#ifndef __OSE__
- /* Check that nobody is running to_erl on this pipe already */
- if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) {
- /* Open as server succeeded -- to_erl is already running! */
- close(wfd);
- fprintf(stderr, "Another to_erl process already attached to pipe "
- "%s.\n", pipename);
- if (force_lock) {
- fprintf(stderr, "But we proceed anyway by force (-F).\n");
- }
- else {
- exit(1);
- }
- }
-#endif
-
- if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
-#ifdef DEBUG
- fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1);
-#endif
- fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno));
- exit(1);
- }
-#ifdef DEBUG
- fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1);
-#endif
-
- if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
-#ifdef DEBUG
- fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2);
-#endif
- fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno));
- close(rfd);
- exit(1);
- }
-#ifdef DEBUG
- fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2);
-#endif
-
-#ifndef __OSE__
- fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename);
-#else
- fprintf(stderr, "Attaching to %s (^C to exit)\n\n", pipename);
-#endif
-
-#ifndef __OSE__
- /* Set break handler to our handler */
- signal(SIGINT,handle_ctrlc);
-
- /*
- * Save the current state of the terminal, and set raw mode.
- */
- if (tcgetattr(0, &tty_rmode) , 0) {
- fprintf(stderr, "Cannot get terminals current mode\n");
- exit(-1);
- }
- tty_smode = tty_rmode;
- tty_eof = '\004'; /* Ctrl+D to exit */
-#ifdef DEBUG
- show_terminal_settings(&tty_rmode);
-#endif
- tty_smode.c_iflag =
- 1*BRKINT |/*Signal interrupt on break.*/
- 1*IGNPAR |/*Ignore characters with parity errors.*/
- 1*ISTRIP |/*Strip character.*/
- 0;
-
-#if 0
-0*IGNBRK |/*Ignore break condition.*/
-0*PARMRK |/*Mark parity errors.*/
-0*INPCK |/*Enable input parity check.*/
-0*INLCR |/*Map NL to CR on input.*/
-0*IGNCR |/*Ignore CR.*/
-0*ICRNL |/*Map CR to NL on input.*/
-0*IUCLC |/*Map upper-case to lower-case on input.*/
-0*IXON |/*Enable start/stop output control.*/
-0*IXANY |/*Enable any character to restart output.*/
-0*IXOFF |/*Enable start/stop input control.*/
-0*IMAXBEL|/*Echo BEL on input line too long.*/
-#endif
-
- tty_smode.c_oflag =
- 1*OPOST |/*Post-process output.*/
- 1*ONLCR |/*Map NL to CR-NL on output.*/
-#ifdef XTABS
- 1*XTABS |/*Expand tabs to spaces. (Linux)*/
-#endif
-#ifdef OXTABS
- 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/
-#endif
-#ifdef NL0
- 1*NL0 |/*Select newline delays*/
-#endif
-#ifdef CR0
- 1*CR0 |/*Select carriage-return delays*/
-#endif
-#ifdef TAB0
- 1*TAB0 |/*Select horizontal tab delays*/
-#endif
-#ifdef BS0
- 1*BS0 |/*Select backspace delays*/
-#endif
-#ifdef VT0
- 1*VT0 |/*Select vertical tab delays*/
-#endif
-#ifdef FF0
- 1*FF0 |/*Select form feed delays*/
-#endif
- 0;
-
-#if 0
-0*OLCUC |/*Map lower case to upper on output.*/
-0*OCRNL |/*Map CR to NL on output.*/
-0*ONOCR |/*No CR output at column 0.*/
-0*ONLRET |/*NL performs CR function.*/
-0*OFILL |/*Use fill characters for delay.*/
-0*OFDEL |/*Fill is DEL, else NULL.*/
-0*NL1 |
-0*CR1 |
-0*CR2 |
-0*CR3 |
-0*TAB1 |
-0*TAB2 |
-0*TAB3 |/*Expand tabs to spaces.*/
-0*BS1 |
-0*VT1 |
-0*FF1 |
-#endif
-
- /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */
- /* advisable if this is a *real* terminal, such as the console. In fact */
- /* this may hang the entire machine, deep, deep down (signalling break */
- /* or toggling the abort switch doesn't help) */
-
- tty_smode.c_lflag =
- 0;
-
-#if 0
-0*ISIG |/*Enable signals.*/
-0*ICANON |/*Canonical input (erase and kill processing).*/
-0*XCASE |/*Canonical upper/lower presentation.*/
-0*ECHO |/*Enable echo.*/
-0*ECHOE |/*Echo erase character as BS-SP-BS.*/
-0*ECHOK |/*Echo NL after kill character.*/
-0*ECHONL |/*Echo NL.*/
-0*NOFLSH |/*Disable flush after interrupt or quit.*/
-0*TOSTOP |/*Send SIGTTOU for background output.*/
-0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/
-0*ECHOPRT|/*Echo erase character as character erased.*/
-0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/
-0*FLUSHO |/*Output is being flushed.*/
-0*PENDIN |/*Retype pending input at next read or input character.*/
-0*IEXTEN |/*Enable extended (implementation-defined) functions.*/
-#endif
-
- tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */
- tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */
- tty_smode.c_cc[VINTR] =3;
-
- tcsetattr(0, TCSADRAIN, &tty_smode);
-
-#ifdef DEBUG
- show_terminal_settings(&tty_smode);
-#endif
-
-#endif /* !__OSE__ */
- /*
- * "Write a ^L to the FIFO which causes the other end to redisplay
- * the input line."
- * This does not seem to work as was intended in old comment above.
- * However, this control character is now (R12B-3) used by run_erl
- * to trigger the version handshaking between to_erl and run_erl
- * at the start of every new to_erl-session.
- */
-
- if (write(wfd, "\014", 1) < 0) {
- fprintf(stderr, "Error in writing ^L to FIFO.\n");
- }
-
-#ifdef __OSE__
- /* we have a tiny stack so we malloc the buffers */
- stdin_buf = malloc(sizeof(char) * BUFSIZ);
- pipe_buf = malloc(sizeof(char) * BUFSIZ);
-
- efs_examine_fd(rfd,FLIB_FD_HANDLE,&pipe_fh);
- efs_examine_fd(0,FLIB_FD_HANDLE,&stdin_fh);
- READ_AIO(stdin_read_req,0,BUFSIZ,stdin_buf);
- READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_buf);
-#endif
-
- /*
- * read and write
- */
- while (1) {
-#ifndef __OSE__
- FD_ZERO(&readfds);
- FD_SET(0, &readfds);
- FD_SET(rfd, &readfds);
- if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) {
- if (recv_sig) {
- FD_ZERO(&readfds);
- }
- else {
- fprintf(stderr, "Error in select.\n");
- break;
- }
- }
- len = 0;
-
- /*
- * Read from terminal and write to FIFO
- */
- if (recv_sig) {
- switch (recv_sig) {
- case SIGINT:
- fprintf(stderr, "[Break]\n\r");
- buf[0] = '\003';
- len = 1;
- break;
- case SIGWINCH:
- len = window_size_seq(buf,sizeof(buf));
- break;
- default:
- fprintf(stderr,"Unexpected signal: %u\n",recv_sig);
- }
- recv_sig = 0;
- }
- else
-#else /* __OSE__ */
- SIGSELECT sigsel[] = {0};
- sig = receive(sigsel);
- len = 0;
-#endif
-#ifndef __OSE__
- if (FD_ISSET(0,&readfds)) {
- len = read(0, buf, sizeof(buf));
-#else /* __OSE__ */
- if (sig->signo == FM_READ_PTR_REPLY &&
- sig->fm_read_ptr.handle == stdin_fh) {
- len = sig->fm_read_ptr.status == EFS_SUCCESS ? sig->fm_read_ptr.actual : -1;
- buf = sig->fm_read_ptr.buffer;
-#endif
- if (len <= 0) {
- close(rfd);
- close(wfd);
- if (len < 0) {
- fprintf(stderr, "Error in reading from stdin.\n");
- } else {
- fprintf(stderr, "[EOF]\n\r");
- }
- break;
- }
- /* check if there is an eof character in input */
- for (i = 0; i < len-1 && buf[i] != tty_eof; i++);
- if (buf[i] == tty_eof) {
- fprintf(stderr, "[Quit]\n\r");
- break;
- }
- }
-
- if (len) {
-#ifdef DEBUG
- if(write(1, buf, len));
-#endif
- if (write_all(wfd, buf, len) != len) {
- fprintf(stderr, "Error in writing to FIFO.\n");
- close(rfd);
- close(wfd);
- break;
- }
- STATUS("\" OK\r\n");
-#ifdef __OSE__
- aio_dispatch(sig);
- READ_AIO(stdin_read_req, 0, BUFSIZ, stdin_buf);
-#endif
- }
-
- /*
- * Read from FIFO, write to terminal.
- */
-#ifndef __OSE__
- if (FD_ISSET(rfd, &readfds)) {
- STATUS("FIFO read: ");
- len = read(rfd, buf, BUFSIZ);
-#else /* __OSE__ */
- if (sig->signo == FM_READ_PTR_REPLY &&
- sig->fm_read_ptr.handle == pipe_fh) {
- len = sig->fm_read_ptr.status == EFS_SUCCESS ? sig->fm_read_ptr.actual : -1;
- buf = sig->fm_read_ptr.buffer;
-#endif
- if (len < 0 && errno == EAGAIN) {
- /*
- * No data this time, but the writing end of the FIFO is still open.
- * Do nothing.
- */
- ;
- } else if (len <= 0) {
- /*
- * Either an error or end of file. In either case, break out
- * of the loop.
- */
- close(rfd);
- close(wfd);
- if (len < 0) {
- fprintf(stderr, "Error in reading from FIFO.\n");
- } else
- fprintf(stderr, "[End]\n\r");
- break;
- } else {
- if (!got_some) {
- if ((len=version_handshake(buf,len,wfd)) < 0) {
- close(rfd);
- close(wfd);
- break;
- }
-#ifndef __OSE__
- if (protocol_ver >= 1) {
- /* Tell run_erl size of terminal window */
- signal(SIGWINCH, handle_sigwinch);
- raise(SIGWINCH);
- }
-#endif
- got_some = 1;
- }
-
- /*
- * We successfully read at least one character. Write what we got.
- */
- STATUS("Terminal write: \"");
- if (write_all(1, buf, len) != len) {
- fprintf(stderr, "Error in writing to terminal.\n");
- close(rfd);
- close(wfd);
- break;
- }
- STATUS("\" OK\r\n");
-#ifdef __OSE__
- aio_dispatch(sig);
- READ_AIO(pipe_read_req, rfd, BUFSIZ, pipe_buf);
-#endif
- }
- }
- }
-
-#ifndef __OSE__
- /*
- * Reset terminal characterstics
- * XXX
- */
- tcsetattr(0, TCSADRAIN, &tty_rmode);
-#endif
- return 0;
-}
-
-/* Call write() until entire buffer has been written or error.
- * Return len or -1.
- */
-static int write_all(int fd, const char* buf, int len)
-{
- int left = len;
- int written;
- while (left) {
- written = write(fd,buf,left);
- if (written < 0) {
- return -1;
- }
- left -= written;
- buf += written;
- }
- return len;
-}
-
-#ifndef __OSE__
-static int window_size_seq(char* buf, size_t bufsz)
-{
-#ifdef TIOCGWINSZ
- struct winsize ws;
- static const char prefix[] = "\033_";
- static const char suffix[] = "\033\\";
- /* This Esc sequence is called "Application Program Command"
- and seems suitable to use for our own customized stuff. */
-
- if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) {
- int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s",
- prefix, ws.ws_col, ws.ws_row, suffix);
- return len;
- }
-#endif /* TIOCGWINSZ */
- return 0;
-}
-#endif /* !__OSE__ */
-
-/* to_erl run_erl
- * | |
- * |---------- '\014' -------->| (session start)
- * | |
- * |<---- "[run_erl v1-0]" ----| (version interval)
- * | |
- * |--- Esc_"version=1"Esc\ -->| (common version)
- * | |
- */
-static int version_handshake(char* buf, int len, int wfd)
-{
- unsigned re_high=0, re_low;
- char *end = find_str(buf,len,"]\n");
-
- if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) {
- char wbuf[30];
- int wlen;
-
- if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) {
- fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n",
- RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low);
- return -1;
- }
- /* Choose highest common version */
- protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER;
-
- wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\",
- protocol_ver);
- if (write_all(wfd, wbuf, wlen) < 0) {
- fprintf(stderr,"Failed to send version handshake\n");
- return -1;
- }
- end += 2;
- len -= (end-buf);
- memmove(buf,end,len);
-
- }
- else { /* we assume old run_erl without version handshake */
- protocol_ver = 0;
- }
-
- if (re_high != RUN_ERL_HI_VER) {
- fprintf(stderr,"run_erl has different version, "
- "using common protocol level %u\n", protocol_ver);
- }
-
- return len;
-}
-
-
-#if defined(DEBUG) && !defined(__OSE__)
-#define S(x) ((x) > 0 ? 1 : 0)
-
-static void show_terminal_settings(struct termios *t)
-{
- fprintf(stderr,"c_iflag:\n");
- fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT));
- fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL));
- fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK));
- fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR));
- fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR));
- fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR));
- fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK));
- fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP));
- fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF));
- fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON));
- fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK));
- fprintf(stderr,"\n");
- fprintf(stderr,"c_oflag:\n");
- fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST));
- fprintf(stderr,"\n");
- fprintf(stderr,"c_cflag:\n");
- fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL));
- fprintf(stderr,"\n");
- fprintf(stderr,"c_local:\n");
- fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO));
- fprintf(stderr,"\n");
- fprintf(stderr,"c_cc:\n");
- fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]);
-}
-#endif /* DEBUG && !__OSE__ */
diff --git a/erts/etc/common/to_erl_common.h b/erts/etc/common/to_erl_common.h
deleted file mode 100644
index a139da418f..0000000000
--- a/erts/etc/common/to_erl_common.h
+++ /dev/null
@@ -1,29 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-#ifndef ERL_TO_ERL_H
-#define ERL_TO_ERL_H
-
-#define TO_ERL_USAGE "to_erl [-h|-F] %s\n" \
- "\t-h\tThis help text.\n" \
- "\t-f\tForce connection even though pipe is locked by other to_erl process."
-
-int to_erl(int argc, char **argv);
-
-#endif
diff --git a/erts/etc/ose/etc.lmconf b/erts/etc/ose/etc.lmconf
deleted file mode 100644
index b402b325b1..0000000000
--- a/erts/etc/ose/etc.lmconf
+++ /dev/null
@@ -1,20 +0,0 @@
-OSE_LM_STACK_SIZES=256,512,1024,2048,4096,8192,16384,65536
-OSE_LM_SIGNAL_SIZES=31,63,127,255,1023,4095,16383,65535
-OSE_LM_POOL_SIZE=0x200000
-OSE_LM_MAIN_NAME=main
-OSE_LM_MAIN_STACK_SIZE=0xF000
-OSE_LM_MAIN_PRIORITY=20
-## Has to be of a type that allows MAM
-OSE_LM_PROGRAM_TYPE=APP_RAM
-OSE_LM_DATA_INIT=YES
-OSE_LM_BSS_INIT=YES
-OSE_LM_EXEC_MODEL=SHARED
-HEAP_MAX_SIZE=1000000000
-HEAP_SMALL_BUF_INIT_SIZE=64000000
-HEAP_LARGE_BUF_THRESHOLD=16000000
-HEAP_LOCK_TYPE=2
-
-# Setting the environment variable EFS_RESOLVE_TMO on the block to 0.
-# This will eliminiate delays when trying to open files on not mounted
-# volumes.
-EFS_RESOLVE_TMO=0
diff --git a/erts/etc/ose/run_erl.c b/erts/etc/ose/run_erl.c
deleted file mode 100644
index 6775525297..0000000000
--- a/erts/etc/ose/run_erl.c
+++ /dev/null
@@ -1,664 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Module: run_erl.c
- *
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-/* System includes */
-#include <aio.h>
-#include <errno.h>
-#include <dirent.h>
-#include <stdlib.h>
-#include <string.h>
-#include <stdio.h>
-#include <sys/stat.h>
-#include <unistd.h>
-
-/* OSE includes */
-#include "ose.h"
-#include "ose_spi/ose_spi.h"
-#include "efs.h"
-#include "pm.h"
-#include "ose_spi/fm.sig"
-
-/* erts includes */
-#include "run_erl.h"
-#include "run_erl_common.h"
-#include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */
-
-typedef struct RunErlSetup_ {
- SIGSELECT signo;
- int run_daemon;
- char *logdir;
- char *command;
- char *pipename;
- char *blockname;
-} RunErlSetup;
-
-typedef struct ProgramState_ {
- /* child process */
- int ifd, ofd;
- OSDOMAIN domain;
- PROCESS progpid, mainbid;
- struct PmProgramInfo *info;
- /* to_erl */
- char w_pipe[FILENAME_BUFSIZ],
- r_pipe[FILENAME_BUFSIZ];
-} ProgramState;
-
-union SIGNAL {
- SIGSELECT signo;
- RunErlSetup setup;
- struct FmReadPtr fm_read_ptr;
- struct FmWritePtr fm_write_ptr;
-};
-
-static OSBOOLEAN hunt_in_block(char *block_name,
- char *process_name,
- PROCESS *pid);
-static int create_child_process(char *command_string, char *blockname,
- ProgramState *state);
-
-
-static OSBOOLEAN hunt_in_block(char *block_name,
- char *process_name,
- PROCESS *pid) {
- struct OS_pid_list *list;
- PROCESS block_id = OSE_ILLEGAL_PROCESS;
- int i;
- char *name;
-
- *pid = OSE_ILLEGAL_PROCESS;
-
- list = get_bid_list(0);
-
- if (!list)
- return 0;
-
- for (i = 0; i < list->count; i++) {
-
- if (list->list[i] == get_bid(current_process()))
- continue;
-
- name = (char*)get_pid_info(list->list[i], OSE_PI_NAME);
- if (name) {
- if (strcmp(name,block_name) == 0) {
- block_id = list->list[i];
- free_buf((union SIGNAL**)&name);
- break;
- }
- free_buf((union SIGNAL**)&name);
- }
- }
-
- free_buf((union SIGNAL**)&list);
-
- if (block_id == OSE_ILLEGAL_PROCESS)
- return 0;
-
- list = get_pid_list(block_id);
-
- if (!list)
- return 0;
-
- for (i = 0; i < list->count; i++) {
- name = (char*)get_pid_info(list->list[i], OSE_PI_NAME);
- if (name) {
- if (strcmp(name,process_name) == 0) {
- *pid = list->list[i];
- free_buf((union SIGNAL**)&name);
- break;
- }
- free_buf((union SIGNAL**)&name);
- }
- }
-
- free_buf((union SIGNAL**)&list);
-
- if (*pid == OSE_ILLEGAL_PROCESS)
- return 0;
-
- return 1;
-
-}
-
-
-static int create_child_process(char *command_string, char *blockname,
- ProgramState *state) {
- char *command = command_string;
- char *argv;
- int i = 0;
- int ret_status;
- PmStatus pm_status;
- int tmp_io[2];
- int fd_arr[3];
- int ifd[2], ofd[2];
- char *handle;
- struct PmLoadModuleInfoReply *mod_info;
-
- /* Parse out cmd and argv from the command string */
- while (1) {
- if (command[i] == ' ' || command[i] == '\0') {
- if (command[i] == '\0')
- argv = NULL;
- else {
- command[i] = '\0';
- argv = command_string + i + 1;
- }
- break;
- }
- i++;
- }
-
- if (blockname)
- handle = blockname;
- else
- handle = simple_basename(command);
-
- if (ose_pm_load_module_info(handle,&mod_info) == PM_SUCCESS) {
- /* Already installed */
- free_buf((union SIGNAL**)&mod_info);
- } else if ((pm_status = ose_pm_install_load_module(0,"ELF",command,handle,0,0,NULL))
- != PM_SUCCESS) {
- ERROR1(LOG_ERR,"ose_pm_install_load_module failed - pmstatus: 0x%08x\n",
- pm_status);
- return 0;
- }
-
- state->domain = PM_NEW_DOMAIN;
-
- pm_status = ose_pm_create_program(&state->domain, handle, 0, 0 , NULL,
- &state->progpid, &state->mainbid);
-
- if (pm_status != PM_SUCCESS) {
- if (pm_status == PM_EINSTALL_HANDLE_IN_USE)
- ERROR1(LOG_ERR,"ose_pm_create_program failed - "
- "install handle \"%s\" is in use. You can specify another "
- "install handle by using the -block option to run_erl.\n",handle);
- else
- ERROR1(LOG_ERR,"ose_pm_create_program failed - pmstatus: 0x%08x\n",
- pm_status);
- return 0;
- }
-
- pm_status = ose_pm_program_info(state->progpid, &state->info);
- /* FIXME don't forget to free this ((union SIGNAL **)&info) */
- if (pm_status != PM_SUCCESS) {
- ERROR1(LOG_ERR,"ose_pm_program_info failed - pmstatus: 0x%08x\n",
- pm_status);
- return 0;
- }
-
- /* We only clone stdin+stdout, what about stderr? */
-
- /* create pipes */
- if (pipe(ifd) < 0) {
- if (errno == ENOENT)
- ERRNO_ERR0(LOG_ERR,"The /pipe file system is not available\n");
- else
- ERRNO_ERR0(LOG_ERR,"pipe ifd failed\n");
- return 0;
- }
-
- if (pipe(ofd) < 0) {
- ERRNO_ERR0(LOG_ERR,"pipe ofd failed\n");
- return 0;
- }
-
- /* FIXME Lock? */
-
- /* backup our stdin stdout */
- if ((tmp_io[0] = dup(0)) < 0) {
- ERRNO_ERR0(LOG_ERR,"dup 0 failed\n");
- return 0;
- }
-
- if ((tmp_io[1] = dup(1)) < 0) {
- ERRNO_ERR0(LOG_ERR,"dup 1 failed\n");
- return 0;
- }
-
- /* set new pipe to fd 0,1 */
- if (dup2(ifd[1], 1) < 0) {
- ERRNO_ERR0(LOG_ERR,"dup2 1 failed\n");
- return 0;
- }
-
- if (dup2(ofd[0], 0) < 0) {
- ERRNO_ERR0(LOG_ERR,"dup2 0 failed\n");
- return 0;
- }
-
- /* clone array to newly created */
- fd_arr[0] = 2; /* Number of fd's */
- fd_arr[1] = 0;
- fd_arr[2] = 1;
-
- if ((ret_status = efs_clone_array(state->info->main_process, fd_arr))
- != EFS_SUCCESS) {
- ERROR1(LOG_ERR,"efs_close_array filed, errcode: %d\n", ret_status);
- return 0;
- }
-
- if (dup2(tmp_io[1], 1) < 0) {
- ERRNO_ERR0(LOG_ERR,"restoring dup2 1 failed\n");
- return 0;
- }
-
- if (dup2(tmp_io[0], 0) < 0) {
- ERRNO_ERR0(LOG_ERR,"restoring dup2 1 failed\n");
- return 0;
- }
-
- /* close loose-ends */
- sf_close(tmp_io[0]);
- sf_close(tmp_io[1]);
- sf_close(ifd[1]);
- sf_close(ofd[0]);
- state->ifd = ifd[0];
- state->ofd = ofd[1];
-
- if (argv && set_env(state->progpid, "ARGV", argv)) {
- ERRNO_ERR0(LOG_ERR,"something went wrong with set_env\n");
- }
-
- /*
- * Start the program.
- */
- pm_status = ose_pm_start_program(state->progpid);
- if (pm_status != PM_SUCCESS) {
- ERROR1(LOG_ERR,"ose_pm_install_load_module failed - pmstatus: 0x%08x\n",
- pm_status);
- return 0;
- }
-
- return 1;
-}
-
-#define SET_AIO(REQ,FD,SIZE,BUFF) \
- /* Make sure to clean data structure of previous request */ \
- memset(&(REQ),0,sizeof(REQ)); \
- (REQ).aio_fildes = FD; \
- (REQ).aio_offset = FM_POSITION_CURRENT; \
- (REQ).aio_nbytes = SIZE; \
- (REQ).aio_buf = BUFF; \
- (REQ).aio_sigevent.sigev_notify = SIGEV_NONE
-
-#define READ_AIO(REQ,FD,SIZE,BUFF) do { \
- SET_AIO(REQ,FD,SIZE,BUFF); \
- if (aio_read(&(REQ)) != 0) \
- ERRNO_ERR1(LOG_ERR,"aio_read of child_read_req(%d) failed\n",FD); \
- } while (0)
-
-#define WRITE_AIO(FD,SIZE,BUFF) do { \
- struct aiocb *write_req = malloc(sizeof(struct aiocb)); \
- char *write_buff = malloc(sizeof(char)*SIZE); \
- memcpy(write_buff,BUFF,SIZE); \
- SET_AIO(*write_req,FD,SIZE,write_buff); \
- if (aio_write(write_req) != 0) \
- ERRNO_ERR1(LOG_ERR,"aio_write of write_req(%d) failed\n",FD); \
- } while(0)
-
-int pass_on(ProgramState *state);
-int pass_on(ProgramState *s) {
- SIGSELECT sigsel[] = {0,FM_READ_PTR_REPLY};
- union SIGNAL *sig;
- char child_read_buff[BUFSIZ], pipe_read_buff[BUFSIZ];
- struct aiocb child_read_req, pipe_read_req;
- int rfd, wfd = 0;
- FmHandle rfh, child_rfh;
- int outstanding_writes = 0, got_some = 0, child_done = 0;
-
- if ((rfd = sf_open(s->r_pipe, O_RDONLY, 0)) < 0) {
- ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.\n", s->r_pipe);
- rfd = 0;
- return 1;
- }
-
- attach(NULL,s->progpid);
-
- /* Open the log file */
- erts_run_erl_log_open();
-
- efs_examine_fd(rfd,FLIB_FD_HANDLE,&rfh);
- efs_examine_fd(s->ifd,FLIB_FD_HANDLE,&child_rfh);
-
- READ_AIO(child_read_req,s->ifd,BUFSIZ,child_read_buff);
- READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff);
-
- while (1) {
- time_t now,last_activity;
-
- time(&last_activity);
- sig = receive_w_tmo(erts_run_erl_log_alive_minutes()*60000,sigsel);
-
- time(&now);
-
- if (sig) {
- erts_run_erl_log_activity(0,now,last_activity);
- } else {
- /* timeout */
- erts_run_erl_log_activity(1,now,last_activity);
- continue;
- }
-
- switch (sig->signo) {
- case OS_ATTACH_SIG: {
- if (rfd) { sf_close(rfd); rfd = 0; }
- free_buf(&sig);
- child_done = 1;
- /* Make sure to to let all outstanding write request finish */
- if (outstanding_writes)
- break;
- if (wfd) sf_close(wfd);
- return 0;
- }
- case FM_WRITE_PTR_REPLY: {
- if (sig->fm_write_ptr.status == EFS_SUCCESS) {
- if (sig->fm_write_ptr.actual < sig->fm_write_ptr.requested) {
- WRITE_AIO(wfd, sig->fm_write_ptr.requested-sig->fm_write_ptr.actual,
- sig->fm_write_ptr.buffer+sig->fm_write_ptr.actual);
- }
- } else {
- /* Assume to_erl has terminated. */
- sf_close(wfd);
- wfd = 0;
- }
- free((char*)sig->fm_write_ptr.buffer);
- aio_dispatch(sig);
- if ((--outstanding_writes == 0) && child_done) {
- if (wfd) sf_close(wfd);
- return 0;
- }
- break;
- }
- case FM_READ_PTR_REPLY: {
- /* Child fd */
- if (sig->fm_read_ptr.handle == child_rfh) {
-
- /* Child terminated */
- if (sig->fm_read_ptr.status != EFS_SUCCESS ||
- sig->fm_read_ptr.actual == 0) {
-
- if (rfd) { sf_close(rfd); rfd = 0; }
-
- if (sig->fm_read_ptr.status != EFS_SUCCESS) {
- ERROR0(LOG_ERR,"Erlang closed the connection.");
- aio_dispatch(sig);
- return 1;
- }
-
- /* child closed connection gracefully */
- aio_dispatch(sig);
- if (outstanding_writes) {
- child_done = 1;
- break;
- }
-
- if (wfd) sf_close(wfd);
-
- return 0;
- } else {
- erts_run_erl_log_write(sig->fm_read_ptr.buffer,
- sig->fm_read_ptr.actual);
- if (wfd) {
- WRITE_AIO(wfd, sig->fm_read_ptr.actual, sig->fm_read_ptr.buffer);
- outstanding_writes++;
- }
- aio_dispatch(sig);
- READ_AIO(child_read_req, s->ifd,BUFSIZ, child_read_buff);
- }
- /* pipe fd */
- } else if (sig->fm_read_ptr.handle == rfh) {
- if (sig->fm_read_ptr.status != EFS_SUCCESS) {
- if(rfd) sf_close(rfd);
- if(wfd) sf_close(wfd);
- aio_dispatch(sig);
- ERRNO_ERR0(LOG_ERR,"Error in reading from FIFO.");
- return 1;
- }
- if (sig->fm_read_ptr.actual == 0) {
- /* to_erl closed its end of the pipe */
- aio_dispatch(sig);
- sf_close(rfd);
- rfd = sf_open(s->r_pipe,O_RDONLY|DONT_BLOCK_PLEASE, 0);
- if (rfd < 0) {
- ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.",
- s->r_pipe);
- rfd = 0;
- } else {
- READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff);
- }
- got_some = 0; /* reset for next session */
- } else {
- int len = sig->fm_read_ptr.actual;
- char *buffer = sig->fm_read_ptr.buffer;
- if (!wfd) {
- /* Try to open the write pipe to to_erl. Now that we got some data
- * from to_erl, to_erl should already be reading this pipe - open
- * should succeed. But in case of error, we just ignore it.
- */
- if ((wfd = sf_open(s->w_pipe, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
- erts_run_erl_log_status("Client expected on FIFO %s, "
- "but can't open (len=%d)\n",
- s->w_pipe, sig->fm_read_ptr.actual);
- sf_close(rfd);
- rfd = sf_open(s->r_pipe, O_RDONLY|DONT_BLOCK_PLEASE, 0);
- if (rfd < 0) {
- ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.",
- s->r_pipe);
- return 1;
- }
- wfd = 0;
- } else {
-#ifdef DEBUG
- erts_run_erl_log_status("run_erl: %s opened for writing\n",
- s->w_pipe);
-#endif
- }
- }
-
- if (!got_some && wfd && buffer[0] == '\014') {
- char wbuf[30];
- int wlen = sn_printf(wbuf,sizeof(wbuf),"[run_erl v%u-%u]\n",
- RUN_ERL_HI_VER, RUN_ERL_LO_VER);
- /* For some reason this, the first write aio seems to
- not get an FM_WRITE_PTR_REPLY, so we do not do:
- outstanding_writes++;
- */
- WRITE_AIO(wfd, wlen, wbuf);
- }
- got_some = 1;
-
- /* Write the message */
-#ifdef DEBUG
- erts_run_erl_log_status("Pty master write; ");
-#endif
- len = erts_run_erl_extract_ctrl_seq(buffer,len, s->ofd);
-
- if (len > 0) {
- int wlen = erts_run_erl_write_all(s->ofd, buffer, len);
- if (wlen != len) {
- aio_dispatch(sig);
- ERRNO_ERR0(LOG_ERR,"Error in writing to terminal.");
- if(rfd) sf_close(rfd);
- if(wfd) sf_close(wfd);
- return 1;
- }
- }
-#ifdef DEBUG
- erts_run_erl_log_status("OK\n");
-#endif
- aio_dispatch(sig);
- READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff);
- }
- }
- break;
- }
- default: {
- free_buf(&sig);
- break;
- }
- }
- }
-}
-
-OS_PROCESS(run_erl_process) {
- char *logdir, *command, *blockname;
- SIGSELECT sigsel[] = {1,ERTS_SIGNAL_RUN_ERL_SETUP};
- union SIGNAL *sig = receive(sigsel);
- ProgramState state;
- char pipename[FILENAME_BUFSIZ];
-
- state.info = NULL;
-
- logdir = strdup(sig->setup.logdir);
- command = strdup(sig->setup.command);
- strn_cpy(pipename,sizeof(pipename),sig->setup.pipename);
-
- if (sig->setup.blockname)
- blockname = strdup(sig->setup.blockname);
- else
- blockname = NULL;
-
- erts_run_erl_log_init(sig->setup.run_daemon, logdir);
-
- free_buf(&sig);
-
- if (erts_run_erl_open_fifo(pipename,state.w_pipe,state.r_pipe))
- kill_proc(current_process());
-
- if (create_child_process(command,blockname,&state))
- pass_on(&state);
-
- free(logdir);
- free(command);
- if (blockname)
- free(blockname);
-
- if (state.info)
- free_buf(((union SIGNAL**)&state.info));
-
- sf_close(state.ifd);
- sf_close(state.ofd);
-
- unlink(state.w_pipe);
- unlink(state.r_pipe);
-
- kill_proc(current_process());
-}
-
-int run_erl(int argc,char **argv) {
- char *pipename, *logdir, *command, *blockname = NULL;
- int pipename_len, logdir_len, command_len, blockname_len = 0;
- int i = 1, run_daemon = 0;
- PROCESS pid;
- SIGSELECT sigsel[] = {0};
- union SIGNAL *sig;
-
- if(argc < 4) {
- fprintf(stderr,RUN_ERL_USAGE,"run_erl");
- return 1;
- }
-
- while (1) {
- if (argv[i][0] != '-')
- break;
- if (!strcmp(argv[i],"-daemon")) {
- run_daemon = 1;
- i++;
- continue;
- }
- if (!strcmp(argv[i],"-block")) {
- blockname = argv[i+1];
- blockname_len = strlen(argv[i+1]) + 1;
- i+=2;
- continue;
- }
- fprintf(stderr,RUN_ERL_USAGE,"run_erl");
- return 1;
- }
-
- pipename = argv[i++];
- logdir = argv[i++];
- command = argv[i++];
-
- /* + 1 to include NULL at end */
- logdir_len = strlen(logdir) + 1;
- command_len = strlen(command) + 1;
- pipename_len = strlen(pipename) + 1;
-
- if (run_daemon) {
- /* We request that the run_erl_process should be started from the
- main process so that it does not die when the shell command
- returns */
- PROCESS main_pid;
- hunt_in_block("run_erl","main",&main_pid);
- sig = alloc(sizeof(*sig),ERTS_SIGNAL_RUN_ERL_DAEMON);
- send(&sig,main_pid);
- sig = receive(sigsel);
- pid = sender(&sig);
- free_buf(&sig);
- } else {
- pid = create_process(OS_BG_PROC,"run_erl_process",
- run_erl_process, 0x800,
- 0, 0, 0, NULL, 0, 0);
- }
-
- sig = alloc(sizeof(RunErlSetup)+
- logdir_len+command_len+pipename_len+blockname_len,
- ERTS_SIGNAL_RUN_ERL_SETUP);
- sig->setup.run_daemon = run_daemon;
- sig->setup.logdir = ((char*)sig)+sizeof(RunErlSetup);
- sig->setup.command = ((char*)sig)+sizeof(RunErlSetup)+logdir_len;
- sig->setup.pipename = ((char*)sig)+sizeof(RunErlSetup)+logdir_len+command_len;
- if (blockname)
- sig->setup.blockname = ((char*)sig)+sizeof(RunErlSetup)+
- logdir_len+command_len+pipename_len;
- else
- sig->setup.blockname = NULL;
-
- strcpy(sig->setup.logdir,logdir);
- strcpy(sig->setup.command,command);
- strcpy(sig->setup.pipename,pipename);
- if (blockname) strcpy(sig->setup.blockname,blockname);
-
- send(&sig,pid);
-
- if (run_daemon) {
- /* We are a daemon, error msgs will be sent to ramlog */
- start(pid);
- return 1;
- }
-
- /* We are not daemon, error msgs will be sent to stderr and we block here */
- efs_clone(pid);
- start(pid);
-
- attach(NULL,pid);
- sig = receive(sigsel);
-
- return 1;
-}
diff --git a/erts/etc/ose/run_erl.h b/erts/etc/ose/run_erl.h
deleted file mode 100644
index bdc8b6c355..0000000000
--- a/erts/etc/ose/run_erl.h
+++ /dev/null
@@ -1,30 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-#ifndef ERL_RUN_ERL_H
-#define ERL_RUN_ERL_H
-
-#include "ose.h"
-
-#include "erts.sig"
-
-int run_erl(int argc, char **argv);
-OS_PROCESS(run_erl_process);
-
-#endif
diff --git a/erts/etc/ose/run_erl_main.c b/erts/etc/ose/run_erl_main.c
deleted file mode 100644
index 8895c773a1..0000000000
--- a/erts/etc/ose/run_erl_main.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Module: run_erl_main.c
- *
- * Container for load module that installs both run_erl and to_erl command.
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include <stdio.h>
-
-#include "ose.h"
-#include "shell.h"
-
-#include "run_erl_common.h"
-#include "run_erl.h"
-#include "to_erl_common.h"
-
-union SIGNAL {
- SIGSELECT signo;
-};
-
-int main(int argc, char **argv)
-{
-
- char run_erl_usage[320],
- to_erl_usage[120];
-
- (void)stdin;(void)stdout;(void)stderr;
-
- sprintf(run_erl_usage,RUN_ERL_USAGE,"run_erl [-daemon] [-block blockname]");
- sprintf(to_erl_usage,TO_ERL_USAGE,"pipename");
-
- shell_add_cmd_attrs(
- "run_erl",run_erl_usage,
- "Redirect Erlang input and output streams",
- run_erl,DEFAULT_PROC_TYPE,DEFAULT_PRIORITY,DEFAULT_STACK_SIZE);
-
- shell_add_cmd_attrs(
- "to_erl",to_erl_usage,
- "Attach to redirected Erlang input and output streams",
- to_erl,DEFAULT_PROC_TYPE,DEFAULT_PRIORITY,DEFAULT_STACK_SIZE);
-
- while (1) {
- static const SIGSELECT sigsel[] = {0};
- union SIGNAL *sig = receive(sigsel);
-
- if (sig->signo == ERTS_SIGNAL_RUN_ERL_DAEMON) {
- PROCESS pid = create_process(OS_BG_PROC,"run_erl_daemon",
- run_erl_process, 0x800,
- 0, 0, 0, NULL, 0, 0);
- send_w_s(&sig,pid,sender(&sig));
- } else {
- printf("Got unexpected signal!");
- free_buf(&sig);
- }
- }
-
- return 1;
-}
diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in
index 19d67de92f..7b554e71f2 100644
--- a/erts/etc/unix/etp-commands.in
+++ b/erts/etc/unix/etp-commands.in
@@ -774,7 +774,7 @@ define etp-pid-1
#
set $etp_pid_1 = (Eterm)($arg0)
if ($etp_pid_1 & 0xF) == 0x3
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff)
else
@@ -834,7 +834,7 @@ define etp-port-1
#
set $etp_port_1 = (Eterm)($arg0)
if ($etp_port_1 & 0xF) == 0x7
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 36) & 0x0fffffff)
else
@@ -1577,7 +1577,7 @@ define etp-term-dump-pid
#
set $etp_pid_1 = (Eterm)($arg0)
if ($etp_pid_1 & 0xF) == 0x3
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff)
else
@@ -1622,7 +1622,7 @@ end
define etp-pid2pix-1
# Args: Eterm
#
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff)
else
@@ -1965,7 +1965,7 @@ end
define etp-port-id2pix-1
# Args: Eterm
#
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff)
elser
@@ -2493,12 +2493,6 @@ define etp-system-info
printf "Little\n"
end
printf "Word size: %d-bit\n", etp_arch_bits
- printf "Halfword: "
- if (etp_halfword)
- printf "yes\n"
- else
- printf "no\n"
- end
printf "HiPE support: "
if (etp_hipe)
printf "yes\n"
diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c
index c8414030ca..44efb975ba 100644
--- a/erts/etc/unix/run_erl.c
+++ b/erts/etc/unix/run_erl.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2015. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -41,13 +41,11 @@
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
-
#ifdef HAVE_WORKING_POSIX_OPENPT
#ifndef _XOPEN_SOURCE
#define _XOPEN_SOURCE 600
#endif
#endif
-
#include <sys/types.h>
#include <sys/wait.h>
#include <sys/stat.h>
@@ -65,6 +63,11 @@
#include <dirent.h>
#include <termios.h>
#include <time.h>
+
+#ifdef __ANDROID__
+# include <termios.h>
+#endif
+
#ifdef HAVE_SYSLOG_H
# include <syslog.h>
#endif
@@ -84,25 +87,81 @@
# include <stropts.h>
#endif
-#include "run_erl_common.h"
+#include "run_erl.h"
#include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */
+#ifdef O_NONBLOCK
+# define DONT_BLOCK_PLEASE O_NONBLOCK
+#else
+# define DONT_BLOCK_PLEASE O_NDELAY
+# ifndef EAGAIN
+# define EAGAIN -3898734
+# endif
+#endif
+
+#define noDEBUG
+
+#define DEFAULT_LOG_GENERATIONS 5
+#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */
+#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */
+#define DEFAULT_LOG_MAXSIZE 100000
+#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */
+#define LOG_STUBNAME "erlang.log."
+#define LOG_PERM 0664
+#define DEFAULT_LOG_ACTIVITY_MINUTES 5
+#define DEFAULT_LOG_ALIVE_MINUTES 15
+#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y"
+#define ALIVE_BUFFSIZ 256
+
+#define PERM 0600
+#define STATUSFILENAME "/run_erl.log"
+#define PIPE_STUBNAME "erlang.pipe"
+#define PIPE_STUBLEN strlen(PIPE_STUBNAME)
+
+#ifndef FILENAME_MAX
+#define FILENAME_MAX 250
+#endif
+
+#ifndef O_SYNC
+#define O_SYNC 0
+#define USE_FSYNC 1
+#endif
+
#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#define FILENAME_BUFSIZ FILENAME_MAX
+
/* prototypes */
static void usage(char *);
+static int create_fifo(char *name, int perm);
static int open_pty_master(char **name, int *sfd);
static int open_pty_slave(char *name);
static void pass_on(pid_t);
static void exec_shell(char **);
+static void status(const char *format,...);
+static void error_logf(int priority, int line, const char *format,...);
static void catch_sigchild(int);
+static int next_log(int log_num);
+static int prev_log(int log_num);
+static int find_next_log_num(void);
+static int open_log(int log_num, int flags);
+static void write_to_log(int* lfd, int* log_num, char* buf, int len);
static void daemon_init(void);
+static char *simple_basename(char *path);
static void init_outbuf(void);
static int outbuf_size(void);
static void clear_outbuf(void);
static char* outbuf_first(void);
static void outbuf_delete(int bytes);
static void outbuf_append(const char* bytes, int n);
+static int write_all(int fd, const char* buf, int len);
+static int extract_ctrl_seq(char* buf, int len);
+static void set_window_size(unsigned col, unsigned row);
+
+static ssize_t sf_write(int fd, const void *buffer, size_t len);
+static ssize_t sf_read(int fd, void *buffer, size_t len);
+static int sf_open(const char *path, int flags, mode_t mode);
+static int sf_close(int fd);
#ifdef DEBUG
static void show_terminal_settings(struct termios *t);
@@ -110,11 +169,20 @@ static void show_terminal_settings(struct termios *t);
/* static data */
static char fifo1[FILENAME_BUFSIZ], fifo2[FILENAME_BUFSIZ];
+static char statusfile[FILENAME_BUFSIZ];
+static char log_dir[FILENAME_BUFSIZ];
static char pipename[FILENAME_BUFSIZ];
static FILE *stdstatus = NULL;
+static int log_generations = DEFAULT_LOG_GENERATIONS;
+static int log_maxsize = DEFAULT_LOG_MAXSIZE;
+static int log_alive_minutes = DEFAULT_LOG_ALIVE_MINUTES;
+static int log_activity_minutes = DEFAULT_LOG_ACTIVITY_MINUTES;
+static int log_alive_in_gmt = 0;
+static char log_alive_format[ALIVE_BUFFSIZ+1];
static int run_daemon = 0;
static char *program_name;
static int mfd; /* master pty fd */
+static unsigned protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */
/*
* Output buffer.
@@ -145,13 +213,29 @@ static char* outbuf_in;
LOG_PID|LOG_CONS|LOG_NOWAIT,LOG_USER)
#endif
+#define ERROR0(Prio,Format) error_logf(Prio,__LINE__,Format"\n")
+#define ERROR1(Prio,Format,A1) error_logf(Prio,__LINE__,Format"\n",A1)
+#define ERROR2(Prio,Format,A1,A2) error_logf(Prio,__LINE__,Format"\n",A1,A2)
+
+#ifdef HAVE_STRERROR
+# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno)
+#else
+# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno
+#endif
+#define ERRNO_ERR0(Prio,Format) error_logf(Prio,__LINE__,ADD_ERRNO(Format))
+#define ERRNO_ERR1(Prio,Format,A1) error_logf(Prio,__LINE__,ADD_ERRNO(Format),A1)
+
+
int main(int argc, char **argv)
{
int childpid;
int sfd = -1;
- char *ptyslave=NULL;
+ int fd;
+ char *p, *ptyslave=NULL;
int i = 1;
int off_argv;
+ int calculated_pipename = 0;
+ int highest_pipe_num = 0;
program_name = argv[0];
@@ -169,16 +253,122 @@ int main(int argc, char **argv)
off_argv = i;
strn_cpy(pipename, sizeof(pipename), argv[i++]);
-
- erts_run_erl_log_init(run_daemon,argv[i]);
+ strn_cpy(log_dir, sizeof(log_dir), argv[i]);
+ strn_cpy(statusfile, sizeof(statusfile), log_dir);
+ strn_cat(statusfile, sizeof(statusfile), STATUSFILENAME);
#ifdef DEBUG
- erts_run_erl_log_status("%s: pid is : %d\n", argv[0], getpid());
+ status("%s: pid is : %d\n", argv[0], getpid());
#endif
- /* Open read and write fifo */
- if (erts_run_erl_open_fifo(pipename,fifo1,fifo2))
- exit(1);
+ /* Get values for LOG file handling from the environment */
+ if ((p = getenv("RUN_ERL_LOG_ALIVE_MINUTES"))) {
+ log_alive_minutes = atoi(p);
+ if (!log_alive_minutes) {
+ ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 "
+ "(current value is %s)",p);
+ }
+ log_activity_minutes = log_alive_minutes / 3;
+ if (!log_activity_minutes) {
+ ++log_activity_minutes;
+ }
+ }
+ if ((p = getenv("RUN_ERL_LOG_ACTIVITY_MINUTES"))) {
+ log_activity_minutes = atoi(p);
+ if (!log_activity_minutes) {
+ ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 "
+ "(current value is %s)",p);
+ }
+ }
+ if ((p = getenv("RUN_ERL_LOG_ALIVE_FORMAT"))) {
+ if (strlen(p) > ALIVE_BUFFSIZ) {
+ ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of "
+ "%d characters", ALIVE_BUFFSIZ);
+ }
+ strn_cpy(log_alive_format, sizeof(log_alive_format), p);
+ } else {
+ strn_cpy(log_alive_format, sizeof(log_alive_format), DEFAULT_LOG_ALIVE_FORMAT);
+ }
+ if ((p = getenv("RUN_ERL_LOG_ALIVE_IN_UTC")) && strcmp(p,"0")) {
+ ++log_alive_in_gmt;
+ }
+ if ((p = getenv("RUN_ERL_LOG_GENERATIONS"))) {
+ log_generations = atoi(p);
+ if (log_generations < LOG_MIN_GENERATIONS)
+ ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d", LOG_MIN_GENERATIONS);
+ if (log_generations > LOG_MAX_GENERATIONS)
+ ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d", LOG_MAX_GENERATIONS);
+ }
+
+ if ((p = getenv("RUN_ERL_LOG_MAXSIZE"))) {
+ log_maxsize = atoi(p);
+ if (log_maxsize < LOG_MIN_MAXSIZE)
+ ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE);
+ }
+
+ /*
+ * Create FIFOs and open them
+ */
+
+ if(*pipename && pipename[strlen(pipename)-1] == '/') {
+ /* The user wishes us to find a unique pipe name in the specified */
+ /* directory */
+ DIR *dirp;
+ struct dirent *direntp;
+
+ calculated_pipename = 1;
+ dirp = opendir(pipename);
+ if(!dirp) {
+ ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename);
+ exit(1);
+ }
+
+ /* Check the directory for existing pipes */
+
+ while((direntp=readdir(dirp)) != NULL) {
+ if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) {
+ int num = atoi(direntp->d_name+PIPE_STUBLEN+1);
+ if(num > highest_pipe_num)
+ highest_pipe_num = num;
+ }
+ }
+ closedir(dirp);
+ strn_catf(pipename, sizeof(pipename), "%s.%d",
+ PIPE_STUBNAME, highest_pipe_num+1);
+ } /* if */
+
+ for(;;) {
+ /* write FIFO - is read FIFO for `to_erl' program */
+ strn_cpy(fifo1, sizeof(fifo1), pipename);
+ strn_cat(fifo1, sizeof(fifo1), ".r");
+ if (create_fifo(fifo1, PERM) < 0) {
+ ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.", fifo1);
+ exit(1);
+ }
+
+ /* read FIFO - is write FIFO for `to_erl' program */
+ strn_cpy(fifo2, sizeof(fifo2), pipename);
+ strn_cat(fifo2, sizeof(fifo2), ".w");
+
+ /* Check that nobody is running run_erl already */
+ if ((fd = sf_open(fifo2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) {
+ /* Open as client succeeded -- run_erl is already running! */
+ sf_close(fd);
+ if (calculated_pipename) {
+ ++highest_pipe_num;
+ strn_catf(pipename, sizeof(pipename), "%s.%d",
+ PIPE_STUBNAME, highest_pipe_num+1);
+ continue;
+ }
+ fprintf(stderr, "Erlang already running on pipe %s.\n", pipename);
+ exit(1);
+ }
+ if (create_fifo(fifo2, PERM) < 0) {
+ ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.", fifo2);
+ exit(1);
+ }
+ break;
+ }
/*
* Open master pseudo-terminal
@@ -250,7 +440,7 @@ int main(int argc, char **argv)
sf_close(2);
if (dup(sfd) != 0 || dup(sfd) != 1 || dup(sfd) != 2) {
- erts_run_erl_log_status("Cannot dup\n");
+ status("Cannot dup\n");
}
sf_close(sfd);
exec_shell(argv+off_argv); /* exec_shell expects argv[2] to be */
@@ -293,7 +483,9 @@ static void pass_on(pid_t childpid)
struct timeval timeout;
time_t last_activity;
char buf[BUFSIZ];
- int rfd, wfd=0;
+ char log_alive_buffer[ALIVE_BUFFSIZ+1];
+ int lognum;
+ int rfd, wfd=0, lfd=0;
int maxfd;
int ready;
int got_some = 0; /* from to_erl */
@@ -308,12 +500,13 @@ static void pass_on(pid_t childpid)
}
#ifdef DEBUG
- erts_run_erl_log_status("run_erl: %s opened for reading\n", fifo2);
+ status("run_erl: %s opened for reading\n", fifo2);
#endif
/* Open the log file */
- erts_run_erl_log_open();
+ lognum = find_next_log_num();
+ lfd = open_log(lognum, O_RDWR|O_APPEND|O_CREAT|O_SYNC);
/* Enter the work loop */
@@ -332,8 +525,7 @@ static void pass_on(pid_t childpid)
writefds_ptr = &writefds;
}
time(&last_activity);
- /* don't assume old BSD bug */
- timeout.tv_sec = erts_run_erl_log_alive_minutes()*60;
+ timeout.tv_sec = log_alive_minutes*60; /* don't assume old BSD bug */
timeout.tv_usec = 0;
ready = select(maxfd + 1, &readfds, writefds_ptr, NULL, &timeout);
if (ready < 0) {
@@ -363,7 +555,28 @@ static void pass_on(pid_t childpid)
/* Check how long time we've been inactive */
time(&now);
- erts_run_erl_log_activity(!ready,now,last_activity);
+ if(!ready || now - last_activity > log_activity_minutes*60) {
+ /* Either a time out: 15 minutes without action, */
+ /* or something is coming in right now, but it's a long time */
+ /* since last time, so let's write a time stamp this message */
+ struct tm *tmptr;
+ if (log_alive_in_gmt) {
+ tmptr = gmtime(&now);
+ } else {
+ tmptr = localtime(&now);
+ }
+ if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, log_alive_format,
+ tmptr)) {
+ strn_cpy(log_alive_buffer, sizeof(log_alive_buffer),
+ "(could not format time in 256 positions "
+ "with current format string.)");
+ }
+ log_alive_buffer[ALIVE_BUFFSIZ] = '\0';
+
+ sn_printf(buf, sizeof(buf), "\n===== %s%s\n",
+ ready?"":"ALIVE ", log_alive_buffer);
+ write_to_log(&lfd, &lognum, buf, strlen(buf));
+ }
}
/*
@@ -398,7 +611,7 @@ static void pass_on(pid_t childpid)
*/
if (FD_ISSET(mfd, &readfds)) {
#ifdef DEBUG
- erts_run_erl_log_status("Pty master read; ");
+ status("Pty master read; ");
#endif
if ((len = sf_read(mfd, buf, BUFSIZ)) <= 0) {
sf_close(rfd);
@@ -416,7 +629,7 @@ static void pass_on(pid_t childpid)
exit(0);
}
- erts_run_erl_log_write(buf, len);
+ write_to_log(&lfd, &lognum, buf, len);
/*
* Save in the output queue.
@@ -432,7 +645,7 @@ static void pass_on(pid_t childpid)
*/
if (FD_ISSET(rfd, &readfds)) {
#ifdef DEBUG
- erts_run_erl_log_status("FIFO read; ");
+ status("FIFO read; ");
#endif
if ((len = sf_read(rfd, buf, BUFSIZ)) < 0) {
sf_close(rfd);
@@ -461,7 +674,7 @@ static void pass_on(pid_t childpid)
* should succeed. But in case of error, we just ignore it.
*/
if ((wfd = sf_open(fifo1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
- erts_run_erl_log_status("Client expected on FIFO %s, but can't open (len=%d)\n",
+ status("Client expected on FIFO %s, but can't open (len=%d)\n",
fifo1, len);
sf_close(rfd);
rfd = sf_open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0);
@@ -473,7 +686,7 @@ static void pass_on(pid_t childpid)
}
else {
#ifdef DEBUG
- erts_run_erl_log_status("run_erl: %s opened for writing\n", fifo1);
+ status("run_erl: %s opened for writing\n", fifo1);
#endif
}
}
@@ -489,15 +702,14 @@ static void pass_on(pid_t childpid)
/* Write the message */
#ifdef DEBUG
- erts_run_erl_log_status("Pty master write; ");
+ status("Pty master write; ");
#endif
- len = erts_run_erl_extract_ctrl_seq(buf, len, mfd);
+ len = extract_ctrl_seq(buf, len);
if(len==1 && buf[0] == '\003') {
kill(childpid,SIGINT);
- }
- else if (len>0 && erts_run_erl_write_all(mfd, buf, len) != len)
- {
+ }
+ else if (len>0 && write_all(mfd, buf, len) != len) {
ERRNO_ERR0(LOG_ERR,"Error in writing to terminal.");
sf_close(rfd);
if(wfd) sf_close(wfd);
@@ -506,7 +718,7 @@ static void pass_on(pid_t childpid)
}
}
#ifdef DEBUG
- erts_run_erl_log_status("OK\n");
+ status("OK\n");
#endif
}
}
@@ -516,6 +728,173 @@ static void catch_sigchild(int sig)
{
}
+/*
+ * next_log:
+ * Returns the index number that follows the given index number.
+ * (Wrapping after log_generations)
+ */
+static int next_log(int log_num) {
+ return log_num>=log_generations?1:log_num+1;
+}
+
+/*
+ * prev_log:
+ * Returns the index number that precedes the given index number.
+ * (Wrapping after log_generations)
+ */
+static int prev_log(int log_num) {
+ return log_num<=1?log_generations:log_num-1;
+}
+
+/*
+ * find_next_log_num()
+ * Searches through the log directory to check which logs that already
+ * exist. It finds the "hole" in the sequence, and returns the index
+ * number for the last log in the log sequence. If there is no hole, index
+ * 1 is returned.
+ */
+static int find_next_log_num(void) {
+ int i, next_gen, log_gen;
+ DIR *dirp;
+ struct dirent *direntp;
+ int log_exists[LOG_MAX_GENERATIONS+1];
+ int stub_len = strlen(LOG_STUBNAME);
+
+ /* Initialize exiting log table */
+
+ for(i=log_generations; i>=0; i--)
+ log_exists[i] = 0;
+ dirp = opendir(log_dir);
+ if(!dirp) {
+ ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", log_dir);
+ exit(1);
+ }
+
+ /* Check the directory for existing logs */
+
+ while((direntp=readdir(dirp)) != NULL) {
+ if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) {
+ int num = atoi(direntp->d_name+stub_len);
+ if(num < 1 || num > log_generations)
+ continue;
+ log_exists[num] = 1;
+ }
+ }
+ closedir(dirp);
+
+ /* Find out the next available log file number */
+
+ next_gen = 0;
+ for(i=log_generations; i>=0; i--) {
+ if(log_exists[i])
+ if(next_gen)
+ break;
+ else
+ ;
+ else
+ next_gen = i;
+ }
+
+ /* Find out the current log file number */
+
+ if(next_gen)
+ log_gen = prev_log(next_gen);
+ else
+ log_gen = 1;
+
+ return log_gen;
+} /* find_next_log_num() */
+
+/* open_log()
+ * Opens a log file (with given index) for writing. Writing may be
+ * at the end or a trucnating write, according to flags.
+ * A LOGGING STARTED and time stamp message is inserted into the log file
+ */
+static int open_log(int log_num, int flags)
+{
+ char buf[FILENAME_MAX];
+ time_t now;
+ struct tm *tmptr;
+ char log_buffer[ALIVE_BUFFSIZ+1];
+ int lfd;
+
+ /* Remove the next log (to keep a "hole" in the log sequence) */
+ sn_printf(buf, sizeof(buf), "%s/%s%d",
+ log_dir, LOG_STUBNAME, next_log(log_num));
+ unlink(buf);
+
+ /* Create or continue on the current log file */
+ sn_printf(buf, sizeof(buf), "%s/%s%d", log_dir, LOG_STUBNAME, log_num);
+ if((lfd = sf_open(buf, flags, LOG_PERM))<0){
+ ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf);
+ exit(1);
+ }
+
+ /* Write a LOGGING STARTED and time stamp into the log file */
+ time(&now);
+ if (log_alive_in_gmt) {
+ tmptr = gmtime(&now);
+ } else {
+ tmptr = localtime(&now);
+ }
+ if (!strftime(log_buffer, ALIVE_BUFFSIZ, log_alive_format,
+ tmptr)) {
+ strn_cpy(log_buffer, sizeof(log_buffer),
+ "(could not format time in 256 positions "
+ "with current format string.)");
+ }
+ log_buffer[ALIVE_BUFFSIZ] = '\0';
+
+ sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n",
+ log_buffer);
+ if (write_all(lfd, buf, strlen(buf)) < 0)
+ status("Error in writing to log.\n");
+
+#if USE_FSYNC
+ fsync(lfd);
+#endif
+
+ return lfd;
+}
+
+/* write_to_log()
+ * Writes a message to a log file. If the current log file is full,
+ * a new log file is opened.
+ */
+static void write_to_log(int* lfd, int* log_num, char* buf, int len)
+{
+ int size;
+
+ /* Decide if new logfile needed, and open if so */
+
+ size = lseek(*lfd,0,SEEK_END);
+ if(size+len > log_maxsize) {
+ sf_close(*lfd);
+ *log_num = next_log(*log_num);
+ *lfd = open_log(*log_num, O_RDWR|O_CREAT|O_TRUNC|O_SYNC);
+ }
+
+ /* Write to log file */
+
+ if (write_all(*lfd, buf, len) < 0) {
+ status("Error in writing to log.\n");
+ }
+
+#if USE_FSYNC
+ fsync(*lfd);
+#endif
+}
+
+/* create_fifo()
+ * Creates a new fifo with the given name and permission.
+ */
+static int create_fifo(char *name, int perm)
+{
+ if ((mkfifo(name, perm) < 0) && (errno != EEXIST))
+ return -1;
+ return 0;
+}
+
/* open_pty_master()
* Find a master device, open and return fd and slave device name.
@@ -712,9 +1091,9 @@ static void exec_shell(char **argv)
else
argv[0] = sh;
argv[1] = "-c";
- erts_run_erl_log_status("Args before exec of shell:\n");
+ status("Args before exec of shell:\n");
for (vp = argv, i = 0; *vp; vp++, i++)
- erts_run_erl_log_status("argv[%d] = %s\n", i, *vp);
+ status("argv[%d] = %s\n", i, *vp);
if (stdstatus) {
fclose(stdstatus);
}
@@ -725,6 +1104,26 @@ static void exec_shell(char **argv)
ERRNO_ERR0(LOG_ERR,"Could not execv");
}
+/* status()
+ * Prints the arguments to a status file
+ * Works like printf (see vfrpintf)
+ */
+static void status(const char *format,...)
+{
+ va_list args;
+ time_t now;
+
+ if (stdstatus == NULL)
+ stdstatus = fopen(statusfile, "w");
+ if (stdstatus == NULL)
+ return;
+ now = time(NULL);
+ fprintf(stdstatus, "run_erl [%d] %s", (int)getpid(), ctime(&now));
+ va_start(args, format);
+ vfprintf(stdstatus, format, args);
+ va_end(args);
+ fflush(stdstatus);
+}
static void daemon_init(void)
/* As R Stevens wants it, to a certain extent anyway... */
@@ -764,10 +1163,47 @@ static void daemon_init(void)
run_daemon = 1;
}
+/* error_logf()
+ * Prints the arguments to stderr or syslog
+ * Works like printf (see vfprintf)
+ */
+static void error_logf(int priority, int line, const char *format, ...)
+{
+ va_list args;
+ va_start(args, format);
+
+#ifdef HAVE_SYSLOG_H
+ if (run_daemon) {
+ vsyslog(priority,format,args);
+ }
+ else
+#endif
+ {
+ time_t now = time(NULL);
+ fprintf(stderr, "run_erl:%d [%d] %s", line, (int)getpid(), ctime(&now));
+ vfprintf(stderr, format, args);
+ }
+ va_end(args);
+}
+
static void usage(char *pname)
{
- fprintf(stderr, "Usage: ");
- fprintf(stderr, RUN_ERL_USAGE, pname);
+ fprintf(stderr, "Usage: %s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"\n", pname);
+ fprintf(stderr, "\nYou may also set the environment variables RUN_ERL_LOG_GENERATIONS\n");
+ fprintf(stderr, "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n");
+ fprintf(stderr, "size of the log file when to switch to the next log file\n");
+}
+
+/* Instead of making sure basename exists, we do our own */
+static char *simple_basename(char *path)
+{
+ char *ptr;
+ for (ptr = path; *ptr != '\0'; ++ptr) {
+ if (*ptr == '/') {
+ path = ptr + 1;
+ }
+ }
+ return path;
}
static void init_outbuf(void)
@@ -838,6 +1274,114 @@ static void outbuf_append(const char* buf, int n)
outbuf_in += n;
}
+/* Call write() until entire buffer has been written or error.
+ * Return len or -1.
+ */
+static int write_all(int fd, const char* buf, int len)
+{
+ int left = len;
+ int written;
+ for (;;) {
+ written = sf_write(fd,buf,left);
+ if (written == left) {
+ return len;
+ }
+ if (written < 0) {
+ return -1;
+ }
+ left -= written;
+ buf += written;
+ }
+}
+
+static ssize_t sf_read(int fd, void *buffer, size_t len) {
+ ssize_t n = 0;
+
+ do { n = read(fd, buffer, len); } while (n < 0 && errno == EINTR);
+
+ return n;
+}
+
+static ssize_t sf_write(int fd, const void *buffer, size_t len) {
+ ssize_t n = 0;
+
+ do { n = write(fd, buffer, len); } while (n < 0 && errno == EINTR);
+
+ return n;
+}
+
+static int sf_open(const char *path, int type, mode_t mode) {
+ int fd = 0;
+
+ do { fd = open(path, type, mode); } while(fd < 0 && errno == EINTR);
+
+ return fd;
+}
+static int sf_close(int fd) {
+ int res = 0;
+
+ do { res = close(fd); } while(fd < 0 && errno == EINTR);
+
+ return res;
+}
+/* Extract any control sequences that are ment only for run_erl
+ * and should not be forwarded to the pty.
+ */
+static int extract_ctrl_seq(char* buf, int len)
+{
+ static const char prefix[] = "\033_";
+ static const char suffix[] = "\033\\";
+ char* bufend = buf + len;
+ char* start = buf;
+ char* command;
+ char* end;
+
+ for (;;) {
+ start = find_str(start, bufend-start, prefix);
+ if (!start) break;
+
+ command = start + strlen(prefix);
+ end = find_str(command, bufend-command, suffix);
+ if (end) {
+ unsigned col, row;
+ if (sscanf(command,"version=%u", &protocol_ver)==1) {
+ /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/
+ }
+ else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) {
+ set_window_size(col,row);
+ }
+ else {
+ ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n",
+ (int)(end-command), command);
+ }
+
+ /* Remove ctrl sequence from buf */
+ end += strlen(suffix);
+ memmove(start, end, bufend-end);
+ bufend -= end - start;
+ }
+ else {
+ ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n",
+ (int)(bufend-start), start);
+ break;
+ }
+ }
+ return bufend - buf;
+}
+
+static void set_window_size(unsigned col, unsigned row)
+{
+#ifdef TIOCSWINSZ
+ struct winsize ws;
+ ws.ws_col = col;
+ ws.ws_row = row;
+ if (ioctl(mfd, TIOCSWINSZ, &ws) < 0) {
+ ERRNO_ERR0(LOG_ERR,"Failed to set window size");
+ }
+#endif
+}
+
+
#ifdef DEBUG
#define S(x) ((x) > 0 ? 1 : 0)
diff --git a/erts/etc/common/run_erl_vsn.h b/erts/etc/unix/run_erl.h
index 2c3e67e81c..cc70a98e52 100644
--- a/erts/etc/common/run_erl_vsn.h
+++ b/erts/etc/unix/run_erl.h
@@ -1,8 +1,8 @@
/*
* %CopyrightBegin%
- *
+ *
* Copyright Ericsson AB 2008-2009. All Rights Reserved.
- *
+ *
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
@@ -14,7 +14,7 @@
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
- *
+ *
* %CopyrightEnd%
*/
@@ -28,3 +28,4 @@
* 0: Older, without version handshake
* 1: R12B-3, version handshake + window size ctrl
*/
+
diff --git a/erts/etc/common/safe_string.c b/erts/etc/unix/safe_string.c
index cdcdbf16f0..a5c11d41d8 100644
--- a/erts/etc/common/safe_string.c
+++ b/erts/etc/unix/safe_string.c
@@ -1,8 +1,8 @@
/*
* %CopyrightBegin%
- *
+ *
* Copyright Ericsson AB 2008-2009. All Rights Reserved.
- *
+ *
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
@@ -14,12 +14,12 @@
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
- *
+ *
* %CopyrightEnd%
*/
-/*
+/*
* Module: safe_string.c
- *
+ *
* This is a bunch of generic string operation
* that are safe regarding buffer overflow.
*
@@ -121,3 +121,4 @@ void* memmove(void *dest, const void *src, size_t n)
return dest;
}
#endif /* HAVE_MEMMOVE */
+
diff --git a/erts/etc/common/safe_string.h b/erts/etc/unix/safe_string.h
index f9d2b2023a..5a471f10de 100644
--- a/erts/etc/common/safe_string.h
+++ b/erts/etc/unix/safe_string.h
@@ -1,8 +1,8 @@
/*
* %CopyrightBegin%
- *
+ *
* Copyright Ericsson AB 2008-2009. All Rights Reserved.
- *
+ *
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
@@ -14,12 +14,12 @@
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
- *
+ *
* %CopyrightEnd%
*/
-/*
+/*
* Module: safe_string.h
- *
+ *
* This is an interface to a bunch of generic string operation
* that are safe regarding buffer overflow.
*
@@ -63,3 +63,4 @@ char* find_str(const char* haystack, int size, const char* needle);
#ifndef HAVE_MEMMOVE
void* memmove(void *dest, const void *src, size_t n);
#endif
+
diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c
index 82d3218964..0bd469727c 100644
--- a/erts/etc/unix/to_erl.c
+++ b/erts/etc/unix/to_erl.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2015. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -17,9 +17,592 @@
*
* %CopyrightEnd%
*/
+/*
+ * Module: to_erl.c
+ *
+ * This module implements a process that opens two specified FIFOs, one
+ * for reading and one for writing; reads from its stdin, and writes what
+ * it has read to the write FIF0; reads from the read FIFO, and writes to
+ * its stdout.
+ *
+ ________ _________
+ | |--<-- pipe.r (fifo1) --<--| |
+ | to_erl | | run_erl | (parent)
+ |________|-->-- pipe.w (fifo2) -->--|_________|
+ ^ master pty
+ |
+ | slave pty
+ ____V____
+ | |
+ | "erl" | (child)
+ |_________|
+ */
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <sys/types.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <termios.h>
+#include <dirent.h>
+#include <signal.h>
+#include <errno.h>
+#ifdef HAVE_SYS_IOCTL_H
+# include <sys/ioctl.h>
+#endif
+
+#include "run_erl.h"
+#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */
+
+#if defined(O_NONBLOCK)
+# define DONT_BLOCK_PLEASE O_NONBLOCK
+#else
+# define DONT_BLOCK_PLEASE O_NDELAY
+# if !defined(EAGAIN)
+# define EAGAIN -3898734
+# endif
+#endif
+
+#ifdef HAVE_STRERROR
+# define STRERROR(x) strerror(x)
+#else
+# define STRERROR(x) ""
+#endif
+
+#define noDEBUG
+
+#define PIPE_DIR "/tmp/"
+#define PIPE_STUBNAME "erlang.pipe"
+#define PIPE_STUBLEN strlen(PIPE_STUBNAME)
+
+#ifdef DEBUG
+#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); }
+#else
+#define STATUS(s)
+#endif
+
+#ifndef FILENAME_MAX
+#define FILENAME_MAX 250
+#endif
+
+static struct termios tty_smode, tty_rmode;
+static int tty_eof = 0;
+static int recv_sig = 0;
+static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */
+
+static int write_all(int fd, const char* buf, int len);
+static int window_size_seq(char* buf, size_t bufsz);
+static int version_handshake(char* buf, int len, int wfd);
+#ifdef DEBUG
+static void show_terminal_settings(struct termios *);
+#endif
+
+static void handle_ctrlc(int sig)
+{
+ /* Reinstall the handler, and signal break flag */
+ signal(SIGINT,handle_ctrlc);
+ recv_sig = SIGINT;
+}
+
+static void handle_sigwinch(int sig)
+{
+ recv_sig = SIGWINCH;
+}
+
+static void usage(char *pname)
+{
+ fprintf(stderr, "Usage: %s [-h|-F] [pipe_name|pipe_dir/]\n", pname);
+ fprintf(stderr, "\t-h\tThis help text.\n");
+ fprintf(stderr, "\t-F\tForce connection even though pipe is locked by other to_erl process.\n");
+}
+
+int main(int argc, char **argv)
+{
+ char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX];
+ int i, len, wfd, rfd;
+ fd_set readfds;
+ char buf[BUFSIZ];
+ char pipename[FILENAME_MAX];
+ int pipeIx = 1;
+ int force_lock = 0;
+ int got_some = 0;
+
+ if (argc >= 2 && argv[1][0]=='-') {
+ switch (argv[1][1]) {
+ case 'h':
+ usage(argv[0]);
+ exit(1);
+ case 'F':
+ force_lock = 1;
+ break;
+ default:
+ fprintf(stderr,"Invalid option '%s'\n",argv[1]);
+ exit(1);
+ }
+ pipeIx = 2;
+ }
+
+#ifdef DEBUG
+ fprintf(stderr, "%s: pid is : %d\n", argv[0], (int)getpid());
+#endif
+
+ strn_cpy(pipename, sizeof(pipename),
+ (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR));
+
+ if(*pipename && pipename[strlen(pipename)-1] == '/') {
+ /* The user wishes us to find a pipe name in the specified */
+ /* directory */
+ int highest_pipe_num = 0;
+ DIR *dirp;
+ struct dirent *direntp;
+
+ dirp = opendir(pipename);
+ if(!dirp) {
+ fprintf(stderr, "Can't access pipe directory %s: %s\n", pipename, strerror(errno));
+ exit(1);
+ }
+
+ /* Check the directory for existing pipes */
+
+ while((direntp=readdir(dirp)) != NULL) {
+ if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) {
+ int num = atoi(direntp->d_name+PIPE_STUBLEN+1);
+ if(num > highest_pipe_num)
+ highest_pipe_num = num;
+ }
+ }
+ closedir(dirp);
+ strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"),
+ PIPE_STUBNAME, highest_pipe_num);
+ } /* if */
+
+ /* read FIFO */
+ sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename);
+ /* write FIFO */
+ sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename);
+
+ /* Check that nobody is running to_erl on this pipe already */
+ if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) {
+ /* Open as server succeeded -- to_erl is already running! */
+ close(wfd);
+ fprintf(stderr, "Another to_erl process already attached to pipe "
+ "%s.\n", pipename);
+ if (force_lock) {
+ fprintf(stderr, "But we proceed anyway by force (-F).\n");
+ }
+ else {
+ exit(1);
+ }
+ }
+
+ if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
+#ifdef DEBUG
+ fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1);
+#endif
+ fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno));
+ exit(1);
+ }
+#ifdef DEBUG
+ fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1);
+#endif
+
+ if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
+#ifdef DEBUG
+ fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2);
+#endif
+ fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno));
+ close(rfd);
+ exit(1);
+ }
+#ifdef DEBUG
+ fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2);
+#endif
+
+ fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename);
+
+ /* Set break handler to our handler */
+ signal(SIGINT,handle_ctrlc);
+
+ /*
+ * Save the current state of the terminal, and set raw mode.
+ */
+ if (tcgetattr(0, &tty_rmode) , 0) {
+ fprintf(stderr, "Cannot get terminals current mode\n");
+ exit(-1);
+ }
+ tty_smode = tty_rmode;
+ tty_eof = '\004'; /* Ctrl+D to exit */
+#ifdef DEBUG
+ show_terminal_settings(&tty_rmode);
+#endif
+ tty_smode.c_iflag =
+ 1*BRKINT |/*Signal interrupt on break.*/
+ 1*IGNPAR |/*Ignore characters with parity errors.*/
+ 1*ISTRIP |/*Strip character.*/
+ 0;
+
+#if 0
+0*IGNBRK |/*Ignore break condition.*/
+0*PARMRK |/*Mark parity errors.*/
+0*INPCK |/*Enable input parity check.*/
+0*INLCR |/*Map NL to CR on input.*/
+0*IGNCR |/*Ignore CR.*/
+0*ICRNL |/*Map CR to NL on input.*/
+0*IUCLC |/*Map upper-case to lower-case on input.*/
+0*IXON |/*Enable start/stop output control.*/
+0*IXANY |/*Enable any character to restart output.*/
+0*IXOFF |/*Enable start/stop input control.*/
+0*IMAXBEL|/*Echo BEL on input line too long.*/
+#endif
+
+ tty_smode.c_oflag =
+ 1*OPOST |/*Post-process output.*/
+ 1*ONLCR |/*Map NL to CR-NL on output.*/
+#ifdef XTABS
+ 1*XTABS |/*Expand tabs to spaces. (Linux)*/
+#endif
+#ifdef OXTABS
+ 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/
+#endif
+#ifdef NL0
+ 1*NL0 |/*Select newline delays*/
+#endif
+#ifdef CR0
+ 1*CR0 |/*Select carriage-return delays*/
+#endif
+#ifdef TAB0
+ 1*TAB0 |/*Select horizontal tab delays*/
+#endif
+#ifdef BS0
+ 1*BS0 |/*Select backspace delays*/
+#endif
+#ifdef VT0
+ 1*VT0 |/*Select vertical tab delays*/
+#endif
+#ifdef FF0
+ 1*FF0 |/*Select form feed delays*/
+#endif
+ 0;
+
+#if 0
+0*OLCUC |/*Map lower case to upper on output.*/
+0*OCRNL |/*Map CR to NL on output.*/
+0*ONOCR |/*No CR output at column 0.*/
+0*ONLRET |/*NL performs CR function.*/
+0*OFILL |/*Use fill characters for delay.*/
+0*OFDEL |/*Fill is DEL, else NULL.*/
+0*NL1 |
+0*CR1 |
+0*CR2 |
+0*CR3 |
+0*TAB1 |
+0*TAB2 |
+0*TAB3 |/*Expand tabs to spaces.*/
+0*BS1 |
+0*VT1 |
+0*FF1 |
+#endif
+
+ /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */
+ /* advisable if this is a *real* terminal, such as the console. In fact */
+ /* this may hang the entire machine, deep, deep down (signalling break */
+ /* or toggling the abort switch doesn't help) */
+
+ tty_smode.c_lflag =
+ 0;
+
+#if 0
+0*ISIG |/*Enable signals.*/
+0*ICANON |/*Canonical input (erase and kill processing).*/
+0*XCASE |/*Canonical upper/lower presentation.*/
+0*ECHO |/*Enable echo.*/
+0*ECHOE |/*Echo erase character as BS-SP-BS.*/
+0*ECHOK |/*Echo NL after kill character.*/
+0*ECHONL |/*Echo NL.*/
+0*NOFLSH |/*Disable flush after interrupt or quit.*/
+0*TOSTOP |/*Send SIGTTOU for background output.*/
+0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/
+0*ECHOPRT|/*Echo erase character as character erased.*/
+0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/
+0*FLUSHO |/*Output is being flushed.*/
+0*PENDIN |/*Retype pending input at next read or input character.*/
+0*IEXTEN |/*Enable extended (implementation-defined) functions.*/
+#endif
+
+ tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */
+ tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */
+ tty_smode.c_cc[VINTR] =3;
+
+ tcsetattr(0, TCSADRAIN, &tty_smode);
+
+#ifdef DEBUG
+ show_terminal_settings(&tty_smode);
+#endif
+ /*
+ * "Write a ^L to the FIFO which causes the other end to redisplay
+ * the input line."
+ * This does not seem to work as was intended in old comment above.
+ * However, this control character is now (R12B-3) used by run_erl
+ * to trigger the version handshaking between to_erl and run_erl
+ * at the start of every new to_erl-session.
+ */
+
+ if (write(wfd, "\014", 1) < 0) {
+ fprintf(stderr, "Error in writing ^L to FIFO.\n");
+ }
+
+ /*
+ * read and write
+ */
+ while (1) {
+ FD_ZERO(&readfds);
+ FD_SET(0, &readfds);
+ FD_SET(rfd, &readfds);
+ if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) {
+ if (recv_sig) {
+ FD_ZERO(&readfds);
+ }
+ else {
+ fprintf(stderr, "Error in select.\n");
+ break;
+ }
+ }
+ len = 0;
+
+ /*
+ * Read from terminal and write to FIFO
+ */
+ if (recv_sig) {
+ switch (recv_sig) {
+ case SIGINT:
+ fprintf(stderr, "[Break]\n\r");
+ buf[0] = '\003';
+ len = 1;
+ break;
+ case SIGWINCH:
+ len = window_size_seq(buf,sizeof(buf));
+ break;
+ default:
+ fprintf(stderr,"Unexpected signal: %u\n",recv_sig);
+ }
+ recv_sig = 0;
+ }
+ else if (FD_ISSET(0, &readfds)) {
+ len = read(0, buf, sizeof(buf));
+ if (len <= 0) {
+ close(rfd);
+ close(wfd);
+ if (len < 0) {
+ fprintf(stderr, "Error in reading from stdin.\n");
+ } else {
+ fprintf(stderr, "[EOF]\n\r");
+ }
+ break;
+ }
+ /* check if there is an eof character in input */
+ for (i = 0; i < len && buf[i] != tty_eof; i++);
+ if (buf[i] == tty_eof) {
+ fprintf(stderr, "[Quit]\n\r");
+ break;
+ }
+ }
+
+ if (len) {
+#ifdef DEBUG
+ if(write(1, buf, len));
+#endif
+ if (write_all(wfd, buf, len) != len) {
+ fprintf(stderr, "Error in writing to FIFO.\n");
+ close(rfd);
+ close(wfd);
+ break;
+ }
+ STATUS("\" OK\r\n");
+ }
+
+ /*
+ * Read from FIFO, write to terminal.
+ */
+ if (FD_ISSET(rfd, &readfds)) {
+ STATUS("FIFO read: ");
+ len = read(rfd, buf, BUFSIZ);
+ if (len < 0 && errno == EAGAIN) {
+ /*
+ * No data this time, but the writing end of the FIFO is still open.
+ * Do nothing.
+ */
+ ;
+ } else if (len <= 0) {
+ /*
+ * Either an error or end of file. In either case, break out
+ * of the loop.
+ */
+ close(rfd);
+ close(wfd);
+ if (len < 0) {
+ fprintf(stderr, "Error in reading from FIFO.\n");
+ } else
+ fprintf(stderr, "[End]\n\r");
+ break;
+ } else {
+ if (!got_some) {
+ if ((len=version_handshake(buf,len,wfd)) < 0) {
+ close(rfd);
+ close(wfd);
+ break;
+ }
+ if (protocol_ver >= 1) {
+ /* Tell run_erl size of terminal window */
+ signal(SIGWINCH, handle_sigwinch);
+ raise(SIGWINCH);
+ }
+ got_some = 1;
+ }
+
+ /*
+ * We successfully read at least one character. Write what we got.
+ */
+ STATUS("Terminal write: \"");
+ if (write_all(1, buf, len) != len) {
+ fprintf(stderr, "Error in writing to terminal.\n");
+ close(rfd);
+ close(wfd);
+ break;
+ }
+ STATUS("\" OK\r\n");
+ }
+ }
+ }
+
+ /*
+ * Reset terminal characterstics
+ * XXX
+ */
+ tcsetattr(0, TCSADRAIN, &tty_rmode);
+ return 0;
+}
+
+/* Call write() until entire buffer has been written or error.
+ * Return len or -1.
+ */
+static int write_all(int fd, const char* buf, int len)
+{
+ int left = len;
+ int written;
+ while (left) {
+ written = write(fd,buf,left);
+ if (written < 0) {
+ return -1;
+ }
+ left -= written;
+ buf += written;
+ }
+ return len;
+}
+
+static int window_size_seq(char* buf, size_t bufsz)
+{
+#ifdef TIOCGWINSZ
+ struct winsize ws;
+ static const char prefix[] = "\033_";
+ static const char suffix[] = "\033\\";
+ /* This Esc sequence is called "Application Program Command"
+ and seems suitable to use for our own customized stuff. */
+
+ if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) {
+ int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s",
+ prefix, ws.ws_col, ws.ws_row, suffix);
+ return len;
+ }
+#endif /* TIOCGWINSZ */
+ return 0;
+}
+
+/* to_erl run_erl
+ * | |
+ * |---------- '\014' -------->| (session start)
+ * | |
+ * |<---- "[run_erl v1-0]" ----| (version interval)
+ * | |
+ * |--- Esc_"version=1"Esc\ -->| (common version)
+ * | |
+ */
+static int version_handshake(char* buf, int len, int wfd)
+{
+ unsigned re_high=0, re_low;
+ char *end = find_str(buf,len,"]\n");
+
+ if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) {
+ char wbuf[30];
+ int wlen;
+
+ if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) {
+ fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n",
+ RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low);
+ return -1;
+ }
+ /* Choose highest common version */
+ protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER;
+
+ wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\",
+ protocol_ver);
+ if (write_all(wfd, wbuf, wlen) < 0) {
+ fprintf(stderr,"Failed to send version handshake\n");
+ return -1;
+ }
+ end += 2;
+ len -= (end-buf);
+ memmove(buf,end,len);
+
+ }
+ else { /* we assume old run_erl without version handshake */
+ protocol_ver = 0;
+ }
+
+ if (re_high != RUN_ERL_HI_VER) {
+ fprintf(stderr,"run_erl has different version, "
+ "using common protocol level %u\n", protocol_ver);
+ }
+
+ return len;
+}
+
-#include "to_erl_common.h"
+#ifdef DEBUG
+#define S(x) ((x) > 0 ? 1 : 0)
-int main(int argc,char **argv) {
- return to_erl(argc,argv);
+static void show_terminal_settings(struct termios *t)
+{
+ fprintf(stderr,"c_iflag:\n");
+ fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT));
+ fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL));
+ fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK));
+ fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR));
+ fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR));
+ fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR));
+ fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK));
+ fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP));
+ fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF));
+ fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON));
+ fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK));
+ fprintf(stderr,"\n");
+ fprintf(stderr,"c_oflag:\n");
+ fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST));
+ fprintf(stderr,"\n");
+ fprintf(stderr,"c_cflag:\n");
+ fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL));
+ fprintf(stderr,"\n");
+ fprintf(stderr,"c_local:\n");
+ fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO));
+ fprintf(stderr,"\n");
+ fprintf(stderr,"c_cc:\n");
+ fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]);
}
+#endif
diff --git a/erts/include/erl_int_sizes_config.h.in b/erts/include/erl_int_sizes_config.h.in
index b18f5ebc00..88c74cdeff 100644
--- a/erts/include/erl_int_sizes_config.h.in
+++ b/erts/include/erl_int_sizes_config.h.in
@@ -35,6 +35,3 @@
/* The size of a pointer. */
#undef SIZEOF_VOID_P
-
-/* Define if building a halfword-heap 64bit emulator (needed for NIF's) */
-#undef HALFWORD_HEAP_EMULATOR
diff --git a/erts/include/internal/erl_printf_format.h b/erts/include/internal/erl_printf_format.h
index efd926be99..953022017a 100644
--- a/erts/include/internal/erl_printf_format.h
+++ b/erts/include/internal/erl_printf_format.h
@@ -44,7 +44,6 @@ typedef long long ErlPfSWord;
#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint'
#endif
-
typedef int (*fmtfn_t)(void*, char*, size_t);
extern int erts_printf_format(fmtfn_t, void*, char*, va_list);
@@ -57,17 +56,9 @@ extern int erts_printf_uword(fmtfn_t, void*, char, int, int, ErlPfUWord);
extern int erts_printf_sword(fmtfn_t, void*, char, int, int, ErlPfSWord);
extern int erts_printf_double(fmtfn_t, void *, char, int, int, double);
-#ifdef HALFWORD_HEAP_EMULATOR
-# if SIZEOF_INT != 4
-# error Unsupported integer size for HALFWORD_HEAP_EMULATOR
-# endif
-typedef unsigned int ErlPfEterm;
-#else
typedef ErlPfUWord ErlPfEterm;
-#endif
-
-extern int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long, ErlPfEterm*);
+extern int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long);
#endif /* ERL_PRINTF_FORMAT_H__ */
diff --git a/erts/include/internal/ethr_internal.h b/erts/include/internal/ethr_internal.h
index d4ded6ff05..693b34df61 100644
--- a/erts/include/internal/ethr_internal.h
+++ b/erts/include/internal/ethr_internal.h
@@ -92,7 +92,6 @@ void ethr_run_exit_handlers__(void);
void ethr_ts_event_destructor__(void *vtsep);
#if defined(ETHR_X86_RUNTIME_CONF__)
-int ethr_x86_have_cpuid__(void);
void ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx);
#endif
diff --git a/erts/include/internal/ethr_mutex.h b/erts/include/internal/ethr_mutex.h
index f76c4262ca..b402a139f5 100644
--- a/erts/include/internal/ethr_mutex.h
+++ b/erts/include/internal/ethr_mutex.h
@@ -98,7 +98,7 @@ void LeaveCriticalSection(CRITICAL_SECTION *);
#if 0
# define ETHR_MTX_Q_LOCK_SPINLOCK__
# define ETHR_MTX_QLOCK_TYPE__ ethr_spinlock_t
-#elif defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)
+#elif defined(ETHR_PTHREADS)
# define ETHR_MTX_Q_LOCK_PTHREAD_MUTEX__
# define ETHR_MTX_QLOCK_TYPE__ pthread_mutex_t
#elif defined(ETHR_WIN32_THREADS)
@@ -211,7 +211,7 @@ struct ethr_cond_ {
#endif
};
-#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
+#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
typedef struct ethr_mutex_ ethr_mutex;
struct ethr_mutex_ {
@@ -355,7 +355,7 @@ void ethr_rwmutex_rwunlock(ethr_rwmutex *);
#ifdef ETHR_MTX_HARD_DEBUG
#define ETHR_MTX_HARD_ASSERT(A) \
- ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, __func__,#A)))
+ ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, __func__, #A)))
#else
#define ETHR_MTX_HARD_ASSERT(A) ((void) 1)
#endif
@@ -634,7 +634,7 @@ ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx)
#endif /* ETHR_TRY_INLINE_FUNCS */
-#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
+#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_MUTEX_IMPL__)
diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h
index 8964f95652..e5c5cdfa33 100644
--- a/erts/include/internal/ethread.h
+++ b/erts/include/internal/ethread.h
@@ -194,28 +194,6 @@ typedef DWORD ethr_tsd_key;
#define ETHR_YIELD() (Sleep(0), 0)
-#elif defined(ETHR_OSE_THREADS)
-
-#include "ose.h"
-#undef NIL
-
-#if defined(ETHR_HAVE_PTHREAD_H)
-#include <pthread.h>
-#endif
-
-typedef struct {
- PROCESS id;
- unsigned int tsd_key_index;
- void *res;
-} ethr_tid;
-
-typedef OSPPDKEY ethr_tsd_key;
-
-#undef ETHR_HAVE_ETHR_SIG_FUNCS
-
-/* Out own RW mutexes are probably faster, but use OSEs mutexes */
-#define ETHR_USE_OWN_RWMTX_IMPL__
-
#else /* No supported thread lib found */
#ifdef ETHR_NO_SUPP_THR_LIB_NOT_FATAL
@@ -296,14 +274,40 @@ ETHR_PROTO_NORETURN__ ethr_fatal_error__(const char *file,
|| (defined(_MSC_VER) && (defined(_M_IX86) || defined(_M_AMD64))))
# define ETHR_X86_RUNTIME_CONF__
-# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \
- (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg != 0, 1))
-# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \
- (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg == 0, 0))
-# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \
- (__builtin_expect(ethr_runtime__.conf.have_sse2 != 0, 1))
-# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \
- (__builtin_expect(ethr_runtime__.conf.have_sse2 == 0, 0))
+# define ETHR_X86_RUNTIME_CONF_HAVE_META(feature) \
+ (__builtin_expect(ethr_runtime__.conf.have_##feature != 0, 1))
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_META(feature) \
+ (__builtin_expect(ethr_runtime__.conf.have_##feature == 0, 0))
+
+# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(dw_cmpxchg)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(dw_cmpxchg)
+# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(sse2)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(sse2)
+# define ETHR_X86_RUNTIME_CONF_HAVE_RDTSCP__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(rdtscp)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_RDTSCP__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(rdtscp)
+# define ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(constant_tsc)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_CONSTANT_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc)
+# define ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(tsc_reliable)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_TSC_RELIABLE_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(tsc_reliable)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC_S3__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc_s3)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC_S3__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc_s3)
+
#endif
#if (defined(__GNUC__) \
@@ -322,6 +326,11 @@ typedef struct {
#if defined(ETHR_X86_RUNTIME_CONF__)
int have_dw_cmpxchg;
int have_sse2;
+ int have_rdtscp;
+ int have_constant_tsc;
+ int have_tsc_reliable;
+ int have_nonstop_tsc;
+ int have_nonstop_tsc_s3;
#endif
#if defined(ETHR_PPC_RUNTIME_CONF__)
int have_lwsync;
@@ -383,19 +392,7 @@ extern ethr_runtime_t ethr_runtime__;
#include "ethr_atomics.h" /* The atomics API */
-#if defined (ETHR_OSE_THREADS)
-static ETHR_INLINE void
-ose_yield(void)
-{
- if (get_ptype(current_process()) == OS_PRI_PROC) {
- set_pri(get_pri(current_process()));
- } else {
- delay(1);
- }
-}
-#endif
-
-#if defined(__GNUC__) && !defined(ETHR_OSE_THREADS)
+#if defined(__GNUC__)
# ifndef ETHR_SPIN_BODY
# if defined(__i386__) || defined(__x86_64__)
# define ETHR_SPIN_BODY __asm__ __volatile__("rep;nop" : : : "memory")
@@ -411,20 +408,9 @@ ose_yield(void)
# ifndef ETHR_SPIN_BODY
# define ETHR_SPIN_BODY do {YieldProcessor();ETHR_COMPILER_BARRIER;} while(0)
# endif
-#elif defined(ETHR_OSE_THREADS)
-# ifndef ETHR_SPIN_BODY
-# define ETHR_SPIN_BODY ose_yield()
-# else
-# error "OSE should use ose_yield()"
-# endif
#endif
-#ifndef ETHR_OSE_THREADS
#define ETHR_YIELD_AFTER_BUSY_LOOPS 50
-#else
-#define ETHR_YIELD_AFTER_BUSY_LOOPS 0
-#endif
-
#ifndef ETHR_SPIN_BODY
# define ETHR_SPIN_BODY ETHR_COMPILER_BARRIER
@@ -447,18 +433,13 @@ ose_yield(void)
# else
# define ETHR_YIELD() (pthread_yield(), 0)
# endif
-# elif defined(ETHR_OSE_THREADS)
-# define ETHR_YIELD() (ose_yield(), 0)
# else
# define ETHR_YIELD() (ethr_compiler_barrier(), 0)
# endif
#endif
-#if defined(VALGRIND) || defined(ETHR_OSE_THREADS)
-/* mutex as fallback for spinlock for VALGRIND and OSE.
- OSE cannot use spinlocks as processes working on the
- same execution unit have a tendency to deadlock.
- */
+#if defined(VALGRIND)
+/* mutex as fallback for spinlock for VALGRIND. */
# undef ETHR_HAVE_NATIVE_SPINLOCKS
# undef ETHR_HAVE_NATIVE_RWSPINLOCKS
#else
@@ -505,16 +486,9 @@ typedef struct {
int detached; /* boolean (default false) */
int suggested_stack_size; /* kilo words (default sys dependent) */
char *name; /* max 14 char long (default no-name) */
-#ifdef ETHR_OSE_THREADS
- U32 coreNo;
-#endif
} ethr_thr_opts;
-#if defined(ETHR_OSE_THREADS)
-#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1, NULL, 0}
-#else
#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1, NULL}
-#endif
#if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_AUX_IMPL__)
# define ETHR_NEED_SPINLOCK_PROTOTYPES__
@@ -628,8 +602,6 @@ typedef struct ethr_ts_event_ ethr_ts_event; /* Needed by ethr_mutex.h */
# include "win/ethr_event.h"
#elif defined(ETHR_PTHREADS)
# include "pthread/ethr_event.h"
-#elif defined(ETHR_OSE_THREADS)
-# include "ose/ethr_event.h"
#endif
int ethr_set_main_thr_status(int, int);
@@ -719,37 +691,6 @@ ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep)
#endif
-#elif defined (ETHR_OSE_THREADS)
-
-#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHREAD_IMPL__)
-
-extern ethr_tsd_key ethr_ts_event_key__;
-
-static ETHR_INLINE ethr_ts_event *
-ETHR_INLINE_FUNC_NAME_(ethr_get_ts_event)(void)
-{
- ethr_ts_event *tsep = *(ethr_ts_event**)ose_get_ppdata(ethr_ts_event_key__);
- if (!tsep) {
- int res = ethr_get_tmp_ts_event__(&tsep);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- ETHR_ASSERT(tsep);
- }
- return tsep;
-}
-
-static ETHR_INLINE void
-ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep)
-{
- if (tsep->iflgs & ETHR_TS_EV_TMP) {
- int res = ethr_free_ts_event__(tsep);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
-}
-
-#endif
-
#endif
#include "ethr_mutex.h" /* Need atomic declarations and tse */
diff --git a/erts/include/internal/ose/ethr_event.h b/erts/include/internal/ose/ethr_event.h
deleted file mode 100644
index c18f30aa4a..0000000000
--- a/erts/include/internal/ose/ethr_event.h
+++ /dev/null
@@ -1,114 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2009-2011. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Author: Rickard Green
- */
-
-//#define USE_PTHREAD_API
-
-#define ETHR_EVENT_OFF_WAITER__ -1L
-#define ETHR_EVENT_OFF__ 1L
-#define ETHR_EVENT_ON__ 0L
-
-#ifdef USE_PTHREAD_API
-
-typedef struct {
- ethr_atomic32_t state;
- pthread_mutex_t mtx;
- pthread_cond_t cnd;
-} ethr_event;
-
-#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__)
-
-static void ETHR_INLINE
-ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e)
-{
- ethr_sint32_t val;
- val = ethr_atomic32_xchg_mb(&e->state, ETHR_EVENT_ON__);
- if (val == ETHR_EVENT_OFF_WAITER__) {
- int res = pthread_mutex_lock(&e->mtx);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- res = pthread_cond_signal(&e->cnd);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- res = pthread_mutex_unlock(&e->mtx);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
-}
-
-static void ETHR_INLINE
-ETHR_INLINE_FUNC_NAME_(ethr_event_reset)(ethr_event *e)
-{
- ethr_atomic32_set(&e->state, ETHR_EVENT_OFF__);
- ETHR_MEMORY_BARRIER;
-}
-
-#endif
-
-#else
-
-typedef struct {
- ethr_atomic32_t state;
- PROCESS proc;
-} ethr_event;
-
-#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__)
-
-static void ETHR_INLINE
-ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e)
-{
- ethr_sint32_t val = ethr_atomic32_xchg_mb(&e->state, ETHR_EVENT_ON__);
- if (val == ETHR_EVENT_OFF_WAITER__) {
-#ifdef DEBUG
- OSFSEMVAL fsem_val = get_fsem(e->proc);
-
- /* There is a race in this assert.
- This is because the state is set before the wait call in wait__.
- We hope that a delay of 10 ms is enough */
- if (fsem_val == 0)
- delay(10);
- ETHR_ASSERT(get_fsem(e->proc) == -1);
-#endif
- signal_fsem(e->proc);
- }
-}
-
-static void ETHR_INLINE
-ETHR_INLINE_FUNC_NAME_(ethr_event_reset)(ethr_event *e)
-{
- ethr_atomic32_set(&e->state, ETHR_EVENT_OFF__);
- ETHR_MEMORY_BARRIER;
-}
-
-#endif
-
-#endif
-
-int ethr_event_init(ethr_event *e);
-int ethr_event_destroy(ethr_event *e);
-int ethr_event_wait(ethr_event *e);
-int ethr_event_swait(ethr_event *e, int spincount);
-#if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__)
-void ethr_event_set(ethr_event *e);
-void ethr_event_reset(ethr_event *e);
-#endif
diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c
index 1262c50718..053217304b 100644
--- a/erts/lib_src/common/erl_misc_utils.c
+++ b/erts/lib_src/common/erl_misc_utils.c
@@ -160,8 +160,6 @@ erts_milli_sleep(long ms)
if (ms > 0) {
#ifdef __WIN32__
Sleep((DWORD) ms);
-#elif defined(__OSE__)
- delay(ms);
#else
struct timeval tv;
tv.tv_sec = ms / 1000;
@@ -320,10 +318,6 @@ erts_cpu_info_update(erts_cpu_info_t *cpuinfo)
online = 0;
#endif
}
-#elif defined(__OSE__)
- online = ose_num_cpus();
- configured = ose_num_cpus();
- available = ose_num_cpus();
#endif
if (online > configured)
diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c
index 307680505c..e7d5d4413e 100644
--- a/erts/lib_src/common/erl_printf_format.c
+++ b/erts/lib_src/common/erl_printf_format.c
@@ -78,15 +78,7 @@
#endif
#ifndef ERTS_SIZEOF_ETERM
-# ifdef HALFWORD_HEAP_EMULATOR
-# if SIZEOF_VOID_P == 8
-# define ERTS_SIZEOF_ETERM 4
-# else
-# error "HALFWORD_HEAP_EMULATOR only allowed on 64-bit architecture"
-# endif
-# else
-# define ERTS_SIZEOF_ETERM SIZEOF_VOID_P
-# endif
+#define ERTS_SIZEOF_ETERM SIZEOF_VOID_P
#endif
#if defined(__GNUC__)
@@ -102,7 +94,7 @@
#endif
#define FMTC_d 0x0000
-#define FMTC_R 0x0001
+/*empty 0x0001 was RELATIVE */
#define FMTC_o 0x0002
#define FMTC_u 0x0003
#define FMTC_x 0x0004
@@ -166,7 +158,7 @@ static char heX[] = "0123456789ABCDEF";
#define SIGN(X) ((X) > 0 ? 1 : ((X) < 0 ? -1 : 0))
#define USIGN(X) ((X) == 0 ? 0 : 1)
-int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long, ErlPfEterm*) = NULL;
+int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long) = NULL;
static int
noop_fn(void *vfp, char* buf, size_t len)
@@ -645,7 +637,6 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap)
case 'p': ptr++; fmt |= FMTC_p; break;
case 'n': ptr++; fmt |= FMTC_n; break;
case 'T': ptr++; fmt |= FMTC_T; break;
- case 'R': ptr++; fmt |= FMTC_R; break;
case '%':
FMT(fn,arg,ptr,1,count);
ptr++;
@@ -820,11 +811,9 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap)
default: *va_arg(ap,int*) = count; break;
}
break;
- case FMTC_T: /* Eterm */
- case FMTC_R: { /* Eterm, Eterm* base (base ignored if !HALFWORD_HEAP) */
+ case FMTC_T: { /* Eterm */
long prec;
ErlPfEterm eterm;
- ErlPfEterm* eterm_base;
if (!erts_printf_eterm_func)
return -EINVAL;
@@ -835,16 +824,14 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap)
else
prec = (long) precision;
eterm = va_arg(ap, ErlPfEterm);
- eterm_base = ((fmt & FMTC_MASK) == FMTC_R) ?
- va_arg(ap, ErlPfEterm*) : NULL;
if (width > 0 && !(fmt & FMTF_adj)) {
- res = (*erts_printf_eterm_func)(noop_fn, NULL, eterm, prec, eterm_base);
+ res = (*erts_printf_eterm_func)(noop_fn, NULL, eterm, prec);
if (res < 0)
return res;
if (width > res)
BLANKS(fn, arg, width - res, count);
}
- res = (*erts_printf_eterm_func)(fn, arg, eterm, prec, eterm_base);
+ res = (*erts_printf_eterm_func)(fn, arg, eterm, prec);
if (res < 0)
return res;
count += res;
diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c
index 0cbb1b2fb8..3e7aad16c7 100644
--- a/erts/lib_src/common/ethr_aux.c
+++ b/erts/lib_src/common/ethr_aux.c
@@ -139,6 +139,38 @@ x86_init(void)
#endif
/* bit 26 of edx is set if we have sse2 */
ethr_runtime__.conf.have_sse2 = (edx & (1 << 26));
+
+ /* check if we have extended feature set */
+ eax = 0x80000000;
+ ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx);
+
+ if (eax < 0x80000001)
+ return;
+
+ if (eax >= 0x80000007) {
+ /* Advanced Power Management Information */
+ eax = 0x80000007;
+ ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx);
+
+ /* I got the values below from:
+ http://lxr.free-electrons.com/source/arch/x86/include/asm/cpufeature.h
+ They can be gotten from the intel/amd manual as well.
+ */
+
+ ethr_runtime__.conf.have_constant_tsc = (edx & (1 << 8));
+ ethr_runtime__.conf.have_tsc_reliable = (edx & (1 << 23));
+ ethr_runtime__.conf.have_nonstop_tsc = (edx & (1 << 24));
+ ethr_runtime__.conf.have_nonstop_tsc_s3 = (edx & (1 << 30));
+
+ }
+
+ /* Extended Processor Info and Feature Bits */
+ eax = 0x80000001;
+ ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx);
+
+ /* bit 27 of edx is set if we have rdtscp */
+ ethr_runtime__.conf.have_rdtscp = (edx & (1 << 27));
+
}
#endif /* ETHR_X86_RUNTIME_CONF__ */
@@ -207,18 +239,7 @@ ethr_init_common__(ethr_init_data *id)
ethr_min_stack_size__ = ETHR_B2KW(ethr_min_stack_size__);
-#ifdef __OSE__
- /* For supervisor processes, OSE adds a number of bytes to the requested stack. With this
- * addition, the resulting size must not exceed the largest available stack size. The number
- * of bytes that will be added is configured in the monolith and can therefore not be
- * specified here. We simply assume that it is less than 0x1000. The available stack sizes
- * are configured in the .lmconf file and the largest one is usually 65536 bytes.
- * Consequently, the requested stack size is limited to 0xF000.
- */
- ethr_max_stack_size__ = 0xF000;
-#else
ethr_max_stack_size__ = 32*1024*1024;
-#endif
#if SIZEOF_VOID_P == 8
ethr_max_stack_size__ *= 2;
#endif
@@ -664,10 +685,6 @@ ETHR_IMPL_NORETURN__ ethr_fatal_error__(const char *file,
int ethr_assert_failed(const char *file, int line, const char *func, char *a)
{
fprintf(stderr, "%s:%d: %s(): Assertion failed: %s\n", file, line, func, a);
-#ifdef __OSE__
- ramlog_printf("%d: %s:%d: %s(): Assertion failed: %s\n",
- current_process(),file, line, func, a);
-#endif
ethr_abort__();
return 0;
}
diff --git a/erts/lib_src/common/ethr_mutex.c b/erts/lib_src/common/ethr_mutex.c
index 72aa34ec1c..a596e6c31c 100644
--- a/erts/lib_src/common/ethr_mutex.c
+++ b/erts/lib_src/common/ethr_mutex.c
@@ -1250,7 +1250,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx)
return 0;
}
-#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
+#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
/* -- pthread mutex and condition variables -------------------------------- */
int
diff --git a/erts/lib_src/ose/ethr_event.c b/erts/lib_src/ose/ethr_event.c
deleted file mode 100644
index 24ea191c4b..0000000000
--- a/erts/lib_src/ose/ethr_event.c
+++ /dev/null
@@ -1,220 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2009-2010. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Author: Rickard Green
- */
-
-#define ETHR_INLINE_FUNC_NAME_(X) X ## __
-#define ETHR_EVENT_IMPL__
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#include "ethread.h"
-
-#ifdef USE_PTHREAD_API
-
-int
-ethr_event_init(ethr_event *e)
-{
- int res;
- ethr_atomic32_init(&e->state, ETHR_EVENT_OFF__);
- res = pthread_mutex_init(&e->mtx, NULL);
- if (res != 0)
- return res;
- res = pthread_cond_init(&e->cnd, NULL);
- if (res != 0) {
- pthread_mutex_destroy(&e->mtx);
- return res;
- }
- return 0;
-}
-
-int
-ethr_event_destroy(ethr_event *e)
-{
- int res;
- res = pthread_mutex_destroy(&e->mtx);
- if (res != 0)
- return res;
- res = pthread_cond_destroy(&e->cnd);
- if (res != 0)
- return res;
- return 0;
-}
-
-static ETHR_INLINE int
-wait__(ethr_event *e, int spincount)
-{
- int sc = spincount;
- ethr_sint32_t val;
- int res, ulres;
- int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS;
-
- if (spincount < 0)
- ETHR_FATAL_ERROR__(EINVAL);
-
- while (1) {
- val = ethr_atomic32_read(&e->state);
- if (val == ETHR_EVENT_ON__)
- return 0;
- if (sc == 0)
- break;
- sc--;
- ETHR_SPIN_BODY;
- if (--until_yield == 0) {
- until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS;
- res = ETHR_YIELD();
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
- }
-
- if (val != ETHR_EVENT_OFF_WAITER__) {
- val = ethr_atomic32_cmpxchg(&e->state,
- ETHR_EVENT_OFF_WAITER__,
- ETHR_EVENT_OFF__);
- if (val == ETHR_EVENT_ON__)
- return 0;
- ETHR_ASSERT(val == ETHR_EVENT_OFF__);
- }
-
- ETHR_ASSERT(val == ETHR_EVENT_OFF_WAITER__
- || val == ETHR_EVENT_OFF__);
-
- res = pthread_mutex_lock(&e->mtx);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
-
- while (1) {
-
- val = ethr_atomic32_read(&e->state);
- if (val == ETHR_EVENT_ON__)
- break;
-
- res = pthread_cond_wait(&e->cnd, &e->mtx);
- if (res == EINTR)
- break;
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
-
- ulres = pthread_mutex_unlock(&e->mtx);
- if (ulres != 0)
- ETHR_FATAL_ERROR__(ulres);
-
- return res; /* 0 || EINTR */
-}
-
-#else
-/* --- OSE implementation of events ---------------------------- */
-
-#ifdef DEBUG
-union SIGNAL {
- SIGSELECT signo;
-};
-#endif
-
-int
-ethr_event_init(ethr_event *e)
-{
- ethr_atomic32_init(&e->state, ETHR_EVENT_OFF__);
- e->proc = current_process();
- return 0;
-}
-
-int
-ethr_event_destroy(ethr_event *e)
-{
- return 0;
-}
-
-static ETHR_INLINE int
-wait__(ethr_event *e, int spincount)
-{
- int sc = spincount;
- int res;
- int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS;
-
- if (spincount < 0)
- ETHR_FATAL_ERROR__(EINVAL);
-
- ETHR_ASSERT(e->proc == current_process());
- ETHR_ASSERT(get_fsem(current_process()) == 0);
-
- while (1) {
- ethr_sint32_t val;
- while (1) {
- val = ethr_atomic32_read(&e->state);
- if (val == ETHR_EVENT_ON__)
- return 0;
- if (sc == 0)
- break;
- sc--;
- ETHR_SPIN_BODY;
- if (--until_yield == 0) {
- until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS;
- res = ETHR_YIELD();
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
- }
- if (val != ETHR_EVENT_OFF_WAITER__) {
- val = ethr_atomic32_cmpxchg(&e->state,
- ETHR_EVENT_OFF_WAITER__,
- ETHR_EVENT_OFF__);
- if (val == ETHR_EVENT_ON__)
- return 0;
- ETHR_ASSERT(val == ETHR_EVENT_OFF__);
- }
-
- wait_fsem(1);
-
- ETHR_ASSERT(get_fsem(current_process()) == 0);
- }
-}
-
-#endif
-
-void
-ethr_event_reset(ethr_event *e)
-{
- ethr_event_reset__(e);
-}
-
-void
-ethr_event_set(ethr_event *e)
-{
- ethr_event_set__(e);
-}
-
-int
-ethr_event_wait(ethr_event *e)
-{
- return wait__(e, 0);
-}
-
-int
-ethr_event_swait(ethr_event *e, int spincount)
-{
- return wait__(e, spincount);
-}
diff --git a/erts/lib_src/ose/ethread.c b/erts/lib_src/ose/ethread.c
deleted file mode 100644
index dc16acdd08..0000000000
--- a/erts/lib_src/ose/ethread.c
+++ /dev/null
@@ -1,833 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2010-2011. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Description: OSE implementation of the ethread library
- * Author: Lukas Larsson
- */
-
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#include "stdio.h"
-#ifdef ETHR_TIME_WITH_SYS_TIME
-# include "time.h"
-# include "sys/time.h"
-#else
-# ifdef ETHR_HAVE_SYS_TIME_H
-# include "sys/time.h"
-# else
-# include "time.h"
-# endif
-#endif
-#include "sys/types.h"
-#include "unistd.h"
-
-#include "limits.h"
-
-#define ETHR_INLINE_FUNC_NAME_(X) X ## __
-#define ETHREAD_IMPL__
-
-#include "ethread.h"
-#include "ethr_internal.h"
-
-#include "erl_printf.h"
-#include "efs.h"
-#include "ose.h"
-
-#include "ose_spi.h"
-
-#include "string.h"
-#include "ctype.h"
-#include "stdlib.h"
-
-#ifndef ETHR_HAVE_ETHREAD_DEFINES
-#error Missing configure defines
-#endif
-
-#define ETHR_INVALID_TID_ID -1
-
-#define DEFAULT_PRIO_NAME "ERTS_ETHR_DEFAULT_PRIO"
-
-/* Set the define to 1 to get some logging */
-#if 0
-#include "ramlog.h"
-#define LOG(output) ramlog_printf output
-#else
-#define LOG(output)
-#endif
-
-static ethr_tid main_thr_tid;
-static const char* own_tid_key = "ethread_own_tid";
-ethr_tsd_key ethr_ts_event_key__;
-
-#define ETHREADWRAPDATASIG 1
-
-/* Init data sent to thr_wrapper() */
-typedef struct {
- SIGSELECT sig_no;
- ethr_ts_event *tse;
- ethr_tid *tid;
- ethr_sint32_t result;
- void *(*thr_func)(void *);
- void *arg;
- void *prep_func_res;
- const char *name;
-} ethr_thr_wrap_data__;
-
-union SIGNAL {
- SIGSELECT sig_no;
- ethr_thr_wrap_data__ data;
-};
-
-#define ETHR_GET_OWN_TID__ ((ethr_tid *) get_envp(current_process(),\
- own_tid_key))
-
-/*
- * --------------------------------------------------------------------------
- * Static functions
- * --------------------------------------------------------------------------
- */
-
-/* Will retrive the instrinsic name by removing the 'prefix' and the
- * suffix from 'name'.
- * The 'prefix' is given as an inparameter. If NULL or an empty string no
- * prefix will be removed.
- * If 'strip_suffix' is 1 suffixes in the form of '_123' will be removed.
- * Will return a pointer to a newly allocated buffer containing the intrinsic
- * name in uppercase characters.
- * The caller must remember to free this buffer when no lnger needed.
- */
-static char *
-ethr_intrinsic_name(const char *name, const char *prefix, int strip_suffix)
-{
- const char *start = name;
- const char *end = name + strlen(name);
- char *intrinsic_name = NULL;
- int i;
-
- if (name == NULL) {
- LOG(("ERTS - ethr_intrinsic_namNo input name.\n"));
- return NULL;
- }
-
- /* take care of the prefix */
- if ((prefix != NULL) && (*prefix != '\0')) {
- const char *found = strstr(name, prefix);
-
- if (found == name) {
- /* found the prefix at the beginning */
- start += strlen(prefix);
- }
- }
-
- /* take care of the suffix */
- if (strip_suffix) {
- const char *suffix_start = strrchr(start, '_');
-
- if (suffix_start != NULL) {
- const char *ch;
- int only_numbers = 1;
-
- for (ch = suffix_start + 1; *ch != '\0'; ch++) {
- if (strchr("0123456789", *ch) == NULL) {
- only_numbers = 0;
- break;
- }
- }
-
- if (only_numbers) {
- end = suffix_start;
- }
- }
- }
-
- intrinsic_name = malloc(end - start + 1);
- for (i = 0; (start + i) < end; i++) {
- intrinsic_name[i] = toupper(start[i]);
- }
- intrinsic_name[i] = '\0';
-
- return intrinsic_name;
-}
-
-static char *
-ethr_get_amended_env(const char *name, const char *prefix, const char *suffix)
-{
- unsigned len;
- char *env_name = NULL;
- char *env_value = NULL;
-
- if (name == NULL) {
- return NULL;
- }
-
- len = strlen(name);
-
- if (prefix != NULL) {
- len += strlen(prefix);
- }
-
- if (suffix != NULL) {
- len += strlen(suffix);
- }
-
- env_name = malloc(len + 1);
- sprintf(env_name, "%s%s%s", (prefix != NULL) ? prefix : "",
- name,
- (suffix != NULL) ? suffix : "");
- env_value = get_env(get_bid(current_process()), env_name);
-
- if (env_value == NULL) {
- LOG(("ERTS - ethr_get_amended_env(): %s environment variable not present\n", env_name));
- } else {
- LOG(("ERTS - ethr_get_amended_env(): Found %s environment variable: %s.\n", env_name, env_value));
- }
- free(env_name);
-
- return env_value;
-}
-
-/* Reads the environment variable derived from 'name' and interprets it as as an
- * OSE priority. If successfull it will update 'out_prio'.
- * Returns: 0 if successfull
- * -1 orherwise.
- */
-static int
-ethr_get_prio(const char *name, OSPRIORITY *out_prio)
-{
- int rc = -1;
- char *intrinsic_name = NULL;
- char *prio_env = NULL;
- long prio;
- char *endptr = NULL;
-
- LOG(("ERTS - ethr_get_prio(): name: %s.\n", name));
-
- intrinsic_name = ethr_intrinsic_name(name, NULL, 1);
- LOG(("ERTS - ethr_get_prio(): Intrinsic name: %s.\n", intrinsic_name));
-
- prio_env = ethr_get_amended_env(intrinsic_name, "ERTS_", "_PRIO");
- if (prio_env == NULL) {
- goto fini;
- }
-
- prio = efs_str_to_long(prio_env, (const char **)&endptr);
- if (endptr != NULL) {
- LOG(("ERTS - ethr_get_prio(): Environment varible for '%s' includes "
- "non-numerical characters: '%s'.\n", intrinsic_name, prio_env));
- goto fini;
- }
-
- if ((prio < 0) || (prio > 32)) {
- LOG(("ERTS - ethr_get_prio(): prio for '%s' (%d) is out of bounds (0-32).\n",
- intrinsic_name, prio));
- goto fini;
- }
-
- /* Success */
- *out_prio = (OSPRIORITY)prio;
- rc = 0;
-
-fini:
- if (intrinsic_name != NULL) {
- free(intrinsic_name);
- }
- if (prio_env != NULL) {
- free_buf((union SIGNAL **) &prio_env);
- }
-
- return rc;
-}
-
-static PROCESS blockId(void) {
- static PROCESS bid = (PROCESS)0;
-
- /* For now we only use the same block. */
- /* if (bid == 0) {
- bid = create_block("Erlang-VM", 0, 0, 0, 0);
- }
- return bid; */
- return 0;
-}
-
-static void thr_exit_cleanup(ethr_tid *tid, void *res)
-{
-
- ETHR_ASSERT(tid == ETHR_GET_OWN_TID__);
-
- tid->res = res;
-
- ethr_run_exit_handlers__();
- ethr_ts_event_destructor__((void *) ethr_get_tse__());
-}
-
-//static OS_PROCESS(thr_wrapper);
-static OS_PROCESS(thr_wrapper)
-{
- ethr_tid my_tid;
- ethr_sint32_t result;
- void *res;
- void *(*thr_func)(void *);
- void *arg;
- ethr_ts_event *tsep = NULL;
-
-#ifdef DEBUG
- {
- PROCESS pid = current_process();
-
- const char *execMode;
-
- PROCESS bid = get_bid(pid);
-
- /* In the call below, 16 is a secret number provided by frbr that makes
- * the function return current domain. */
- OSADDRESS domain = get_pid_info(current_process(), 16);
-
-#ifdef HAVE_OSE_SPI_H
- execMode = get_pid_info(pid, OSE_PI_SUPERVISOR)
- ? "Supervisor"
- : "User";
-#else
- execMode = "unknown";
-#endif
-
- fprintf(stderr,"[0x%x] New process. Bid:0x%x, domain:%d, exec mode:%s\n",
- current_process(), bid, domain, execMode);
- }
-#endif
-
- {
- SIGSELECT sigsel[] = {1,ETHREADWRAPDATASIG};
- union SIGNAL *init_msg = receive(sigsel);
-
- thr_func = init_msg->data.thr_func;
- arg = init_msg->data.arg;
-
- result = (ethr_sint32_t) ethr_make_ts_event__(&tsep);
-
- if (result == 0) {
- tsep->iflgs |= ETHR_TS_EV_ETHREAD;
- my_tid = *init_msg->data.tid;
- set_envp(current_process(), own_tid_key, (OSADDRESS)&my_tid);
- if (ethr_thr_child_func__)
- ethr_thr_child_func__(init_msg->data.prep_func_res);
- }
-
- init_msg->data.result = result;
-
- send(&init_msg,sender(&init_msg));
- }
-
- /* pthread mutex api says we have to do this */
- signal_fsem(current_process());
- ETHR_ASSERT(get_fsem(current_process()) == 0);
-
- res = result == 0 ? (*thr_func)(arg) : NULL;
-
- ethr_thr_exit(&res);
-}
-
-/* internal exports */
-
-int ethr_set_tse__(ethr_ts_event *tsep)
-{
- return ethr_tsd_set(ethr_ts_event_key__,(void *) tsep);
-}
-
-ethr_ts_event *ethr_get_tse__(void)
-{
- return (ethr_ts_event *) ethr_tsd_get(ethr_ts_event_key__);
-}
-
-#if defined(ETHR_PPC_RUNTIME_CONF__)
-
-static int
-ppc_init__(void)
-{
- int pid;
-
-
- ethr_runtime__.conf.have_lwsync = 0;
-
- return 0;
-}
-
-#endif
-
-#if defined(ETHR_X86_RUNTIME_CONF__)
-
-void
-ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx)
-{
-#if ETHR_SIZEOF_PTR == 4
- int have_cpuid;
- /*
- * If it is possible to toggle eflags bit 21,
- * we have the cpuid instruction.
- */
- __asm__ ("pushf\n\t"
- "popl %%eax\n\t"
- "movl %%eax, %%ecx\n\t"
- "xorl $0x200000, %%eax\n\t"
- "pushl %%eax\n\t"
- "popf\n\t"
- "pushf\n\t"
- "popl %%eax\n\t"
- "movl $0x0, %0\n\t"
- "xorl %%ecx, %%eax\n\t"
- "jz no_cpuid\n\t"
- "movl $0x1, %0\n\t"
- "no_cpuid:\n\t"
- : "=r"(have_cpuid)
- :
- : "%eax", "%ecx", "cc");
- if (!have_cpuid) {
- *eax = *ebx = *ecx = *edx = 0;
- return;
- }
-#endif
-#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__
- /*
- * When position independet code is used in 32-bit mode, the B register
- * is used for storage of global offset table address, and we may not
- * use it as input or output in an asm. We need to save and restore the
- * B register explicitly (for some reason gcc doesn't provide this
- * service to us).
- */
- __asm__ ("pushl %%ebx\n\t"
- "cpuid\n\t"
- "movl %%ebx, %1\n\t"
- "popl %%ebx\n\t"
- : "=a"(*eax), "=r"(*ebx), "=c"(*ecx), "=d"(*edx)
- : "0"(*eax)
- : "cc");
-#else
- __asm__ ("cpuid\n\t"
- : "=a"(*eax), "=b"(*ebx), "=c"(*ecx), "=d"(*edx)
- : "0"(*eax)
- : "cc");
-#endif
-}
-
-#endif /* ETHR_X86_RUNTIME_CONF__ */
-
-/*
- * --------------------------------------------------------------------------
- * Exported functions
- * --------------------------------------------------------------------------
- */
-
-int
-ethr_init(ethr_init_data *id)
-{
- int res;
-
- if (!ethr_not_inited__)
- return EINVAL;
-
-
-#if defined(ETHR_PPC_RUNTIME_CONF__)
- res = ppc_init__();
- if (res != 0)
- goto error;
-#endif
-
- res = ethr_init_common__(id);
- if (res != 0)
- goto error;
-
- main_thr_tid.id = current_process();
- main_thr_tid.tsd_key_index = 0;
-
- set_envp(current_process(),own_tid_key,(OSADDRESS)&main_thr_tid);
- signal_fsem(current_process());
-
-
- ETHR_ASSERT(&main_thr_tid == ETHR_GET_OWN_TID__);
-
- ethr_not_inited__ = 0;
-
- ethr_tsd_key_create(&ethr_ts_event_key__,"ethread_tse");
-
- return 0;
- error:
- ethr_not_inited__ = 1;
- return res;
-
-}
-
-int
-ethr_late_init(ethr_late_init_data *id)
-{
- int res = ethr_late_init_common__(id);
- if (res != 0)
- return res;
- ethr_not_completely_inited__ = 0;
- return res;
-}
-
-int
-ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg,
- ethr_thr_opts *opts)
-{
- int res;
- int use_stack_size = (opts && opts->suggested_stack_size >= 0
- ? opts->suggested_stack_size
- : 0x200 /* Use system default */);
- OSPRIORITY use_prio;
- char *use_name;
- char default_thr_name[20];
- static int no_of_thr = 0;
- cpuid_t use_core;
-
- union SIGNAL *init_msg;
- SIGSELECT sigsel[] = {1,ETHREADWRAPDATASIG};
- void *prep_func_res;
-
-
- if (opts != NULL) {
- LOG(("ERTS - ethr_thr_create(): opts supplied: name: %s, coreNo: %u.\n",
- opts->name, opts->coreNo));
- use_name = opts->name;
- use_core = opts->coreNo;
- if (0 != ethr_get_prio(use_name, &use_prio)) {
- if (0 != ethr_get_prio("DEFAULT", &use_prio)) {
- use_prio = get_pri(current_process());
- LOG(("ERTS - ethr_thr_create(): Using current process' prio: %d.\n", use_prio));
- } else {
- LOG(("ERTS - ethr_thr_create(): Using default prio: %d.\n", use_prio));
- }
- } else {
- LOG(("ERTS - ethr_thr_create(): Using configured prio: %d.\n", use_prio));
- }
- } else {
- LOG(("ERTS - ethr_thr_create(): opts not supplied. Using defaults.\n"));
- no_of_thr++;
- sprintf(default_thr_name, "ethread_%d", no_of_thr);
- use_name = default_thr_name;
- use_core = ose_cpu_id();
-
- if (0 != ethr_get_prio("DEFAULT", &use_prio)) {
- use_prio = get_pri(current_process());
- LOG(("ERTS - ethr_thr_create(): Using current process' prio: %d.\n", use_prio));
- }
- }
-
-#ifdef ETHR_MODIFIED_DEFAULT_STACK_SIZE
- if (use_stack_size < 0)
- use_stack_size = ETHR_MODIFIED_DEFAULT_STACK_SIZE;
-#endif
-
-#if ETHR_XCHK
- if (ethr_not_completely_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
- if (!tid || !func) {
- ETHR_ASSERT(0);
- return EINVAL;
- }
-#endif
-
- if (use_stack_size >= 0) {
- size_t suggested_stack_size = (size_t) use_stack_size;
- size_t stack_size;
-#ifdef ETHR_DEBUG
- suggested_stack_size /= 2; /* Make sure we got margin */
-#endif
-#ifdef ETHR_STACK_GUARD_SIZE
- /* The guard is at least on some platforms included in the stack size
- passed when creating threads */
- suggested_stack_size += ETHR_B2KW(ETHR_STACK_GUARD_SIZE);
-#endif
-
- if (suggested_stack_size < ethr_min_stack_size__)
- stack_size = ETHR_KW2B(ethr_min_stack_size__);
- else if (suggested_stack_size > ethr_max_stack_size__)
- stack_size = ETHR_KW2B(ethr_max_stack_size__);
- else
- stack_size = ETHR_PAGE_ALIGN(ETHR_KW2B(suggested_stack_size));
- use_stack_size = stack_size;
- }
-
- init_msg = alloc(sizeof(ethr_thr_wrap_data__), ETHREADWRAPDATASIG);
-
- /* Call prepare func if it exist */
- if (ethr_thr_prepare_func__)
- init_msg->data.prep_func_res = ethr_thr_prepare_func__();
- else
- init_msg->data.prep_func_res = NULL;
-
- LOG(("ERTS - ethr_thr_create(): Process [0x%x] is creating '%s', coreNo = %u, prio:%u\n",
- current_process(), use_name, use_core, use_prio));
-
- tid->id = create_process(OS_PRI_PROC, use_name, thr_wrapper,
- use_stack_size, use_prio, 0,
- get_bid(current_process()), NULL, 0, 0);
- if (ose_bind_process(tid->id, use_core)) {
- LOG(("ERTS - ethr_thr_create(): Bound pid 0x%x (%s) to core no %u.\n",
- tid->id, use_name, use_core));
- } else {
- LOG(("ERTS - ethr_thr_create(): Failed binding pid 0x%x (%s) to core no %u.\n",
- tid->id, use_name, use_core));
- }
-
- /*FIXME!!! Normally this shouldn't be used in shared mode. Still there is
- * a problem with stdin fd in fd_ processes which should be further
- * investigated */
- efs_clone(tid->id);
-
- tid->tsd_key_index = 0;
- tid->res = NULL;
-
- init_msg->data.tse = ethr_get_ts_event();
- init_msg->data.thr_func = func;
- init_msg->data.arg = arg;
- init_msg->data.tid = tid;
- init_msg->data.name = opts->name;
-
- send(&init_msg, tid->id);
-
- start(tid->id);
- init_msg = receive(sigsel);
-
- res = init_msg->data.result;
- prep_func_res = init_msg->data.prep_func_res;
-
- free_buf(&init_msg);
- /* Cleanup... */
-
- if (ethr_thr_parent_func__)
- ethr_thr_parent_func__(prep_func_res);
-
- LOG(("ERTS - ethr_thr_create(): Exiting.\n"));
- return res;
-}
-
-int
-ethr_thr_join(ethr_tid tid, void **res)
-{
- SIGSELECT sigsel[] = {1,OS_ATTACH_SIG};
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
-#endif
-
- if (tid.id == ETHR_INVALID_TID_ID)
- return EINVAL;
-
- attach(NULL,tid.id);
- receive(sigsel);
-
- if (res)
- *res = tid.res;
-
- return 0;
-}
-
-int
-ethr_thr_detach(ethr_tid tid)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
-#endif
- return 0;
-}
-
-void
-ethr_thr_exit(void *res)
-{
- ethr_tid *tid;
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return;
- }
-#endif
- tid = ETHR_GET_OWN_TID__;
- if (!tid) {
- ETHR_ASSERT(0);
- kill_proc(current_process());
- }
- thr_exit_cleanup(tid, res);
- /* Harakiri possible? */
- kill_proc(current_process());
-}
-
-ethr_tid
-ethr_self(void)
-{
- ethr_tid *tid;
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ethr_tid dummy_tid = {ETHR_INVALID_TID_ID, 0, NULL};
- ETHR_ASSERT(0);
- return dummy_tid;
- }
-#endif
- tid = ETHR_GET_OWN_TID__;
- if (!tid) {
- ethr_tid dummy_tid = {ETHR_INVALID_TID_ID, 0, NULL};
- return dummy_tid;
- }
- return *tid;
-}
-
-int
-ethr_equal_tids(ethr_tid tid1, ethr_tid tid2)
-{
- return tid1.id == tid2.id && tid1.id != ETHR_INVALID_TID_ID;
-}
-
-
-/*
- * Thread specific events
- */
-
-ethr_ts_event *
-ethr_get_ts_event(void)
-{
- return ethr_get_ts_event__();
-}
-
-void
-ethr_leave_ts_event(ethr_ts_event *tsep)
-{
- ethr_leave_ts_event__(tsep);
-}
-
-/*
- * Thread specific data
- */
-
-int
-ethr_tsd_key_create(ethr_tsd_key *keyp, char *keyname)
-{
-
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
- if (!keyp) {
- ETHR_ASSERT(0);
- return EINVAL;
- }
-#endif
-
- ose_create_ppdata(keyname,keyp);
-
- return 0;
-}
-
-int
-ethr_tsd_key_delete(ethr_tsd_key key)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
-#endif
- /* Not possible to delete ppdata */
-
- return 0;
-}
-
-int
-ethr_tsd_set(ethr_tsd_key key, void *value)
-{
- void **ppdp;
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
-#endif
- ppdp = (void **)ose_get_ppdata(key);
- *ppdp = value;
- return 0;
-}
-
-void *
-ethr_tsd_get(ethr_tsd_key key)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return NULL;
- }
-#endif
- return *(void**)ose_get_ppdata(key);
-}
-
-/*
- * Signal functions
- */
-
-#if ETHR_HAVE_ETHR_SIG_FUNCS
-
-int ethr_sigmask(int how, const sigset_t *set, sigset_t *oset)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
- if (!set && !oset) {
- ETHR_ASSERT(0);
- return EINVAL;
- }
-#endif
- return pthread_sigmask(how, set, oset);
-}
-
-int ethr_sigwait(const sigset_t *set, int *sig)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
- if (!set || !sig) {
- ETHR_ASSERT(0);
- return EINVAL;
- }
-#endif
- if (sigwait(set, sig) < 0)
- return errno;
- return 0;
-}
-
-#endif /* #if ETHR_HAVE_ETHR_SIG_FUNCS */
-
-ETHR_IMPL_NORETURN__
-ethr_abort__(void)
-{
- abort();
-}
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index 4a6fb6109f..ca9e6bd20f 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 36862802ca..b353129a34 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam
new file mode 100644
index 0000000000..4188e5fd9b
--- /dev/null
+++ b/erts/preloaded/ebin/erts_code_purger.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index 21dde7f257..88da34b192 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
Binary files differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index 9b0fc82bed..8ac7f5b471 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
Binary files differ
diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam
index c8166d5ed7..3cd2515ba8 100644
--- a/erts/preloaded/ebin/otp_ring0.beam
+++ b/erts/preloaded/ebin/otp_ring0.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam
index ddcc3886a4..9a208d1545 100644
--- a/erts/preloaded/ebin/prim_eval.beam
+++ b/erts/preloaded/ebin/prim_eval.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam
index 9256e35553..426e764127 100644
--- a/erts/preloaded/ebin/prim_file.beam
+++ b/erts/preloaded/ebin/prim_file.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam
index 72065661c5..d68d18ecba 100644
--- a/erts/preloaded/ebin/prim_inet.beam
+++ b/erts/preloaded/ebin/prim_inet.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam
index 2a0b33279d..01b3b1feb8 100644
--- a/erts/preloaded/ebin/prim_zip.beam
+++ b/erts/preloaded/ebin/prim_zip.beam
Binary files differ
diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam
index 0d3d1d9343..7252d866bb 100644
--- a/erts/preloaded/ebin/zlib.beam
+++ b/erts/preloaded/ebin/zlib.beam
Binary files differ
diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile
index 52034a0881..31383dda83 100644
--- a/erts/preloaded/src/Makefile
+++ b/erts/preloaded/src/Makefile
@@ -41,6 +41,7 @@ PRE_LOADED_ERL_MODULES = \
zlib \
prim_zip \
otp_ring0 \
+ erts_code_purger \
erlang \
erts_internal
diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index 9f6cba33bd..824ed3435d 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -42,7 +42,7 @@
-include("inet_boot.hrl").
%% Public
--export([start/3, set_path/1, get_path/0, get_file/1, get_files/2,
+-export([start/0, set_path/1, get_path/0, get_file/1,
list_dir/1, read_file_info/1, read_link_info/1, get_cwd/0, get_cwd/1]).
%% Used by erl_boot_server
@@ -50,30 +50,28 @@
prim_read_file_info/3, prim_get_cwd/2]).
%% Used by escript and code
--export([set_primary_archive/4, release_archives/0]).
+-export([set_primary_archive/4]).
+
+%% Used by test suites
+-export([purge_archive_cache/0]).
-include_lib("kernel/include/file.hrl").
-type host() :: atom().
-record(prim_state, {debug :: boolean(),
- cache,
primary_archive}).
-type prim_state() :: #prim_state{}.
-record(state,
{loader :: 'efile' | 'inet',
hosts = [] :: [host()], % hosts list (to boot from)
- id, % not used any more?
data :: 'noport' | port(), % data port etc
- timeout :: timeout(), % idle timeout
- %% Number of timeouts before archives are released
- n_timeouts :: non_neg_integer(),
- multi_get = false :: boolean(),
+ timeout :: timeout(), % idle timeout
prim_state :: prim_state()}). % state for efile code loader
--define(IDLE_TIMEOUT, 60000). %% tear inet connection after 1 minutes
--define(N_TIMEOUTS, 6). %% release efile archive after 6 minutes
+-define(EFILE_IDLE_TIMEOUT, (6*60*1000)). %purge archives
+-define(INET_IDLE_TIMEOUT, (60*1000)). %tear down connection timeout
%% Defines for inet as prim_loader
-define(INET_FAMILY, inet).
@@ -103,26 +101,13 @@ debug(#prim_state{debug = Deb}, Term) ->
%%% Interface Functions.
%%% --------------------------------------------------------
--spec start(Id, Loader, Hosts) ->
+-spec start() ->
{'ok', Pid} | {'error', What} when
- Id :: term(),
- Loader :: atom() | string(),
- Hosts :: Host | [Host],
- Host :: host(),
Pid :: pid(),
What :: term().
-start(Id, Pgm, Hosts) when is_atom(Hosts) ->
- start(Id, Pgm, [Hosts]);
-start(Id, Pgm0, Hosts) ->
- Pgm = if
- is_atom(Pgm0) ->
- atom_to_list(Pgm0);
- true ->
- Pgm0
- end,
+start() ->
Self = self(),
- Pid = spawn_link(fun() -> start_it(Pgm, Id, Self, Hosts) end),
- register(erl_prim_loader, Pid),
+ Pid = spawn_link(fun() -> start_it(Self) end),
receive
{Pid,ok} ->
{ok,Pid};
@@ -130,26 +115,39 @@ start(Id, Pgm0, Hosts) ->
{error,Reason}
end.
-%% Hosts must be a list of form ['1.2.3.4' ...]
-start_it("inet", Id, Pid, Hosts) ->
+start_it(Parent) ->
process_flag(trap_exit, true),
- ?dbg(inet, {Id,Pid,Hosts}),
+ register(erl_prim_loader, self()),
+ Loader = case init:get_argument(loader) of
+ {ok,[[Loader0]]} ->
+ Loader0;
+ error ->
+ "efile"
+ end,
+ case Loader of
+ "efile" -> start_efile(Parent);
+ "inet" -> start_inet(Parent)
+ end.
+
+%% Hosts must be a list of form ['1.2.3.4' ...]
+start_inet(Parent) ->
+ Hosts = case init:get_argument(hosts) of
+ {ok,[Hosts0]} -> Hosts0;
+ _ -> []
+ end,
AL = ipv4_list(Hosts),
?dbg(addresses, AL),
{ok,Tcp} = find_master(AL),
- init_ack(Pid),
+ init_ack(Parent),
PS = prim_init(),
State = #state {loader = inet,
hosts = AL,
- id = Id,
data = Tcp,
- timeout = ?IDLE_TIMEOUT,
- n_timeouts = ?N_TIMEOUTS,
+ timeout = ?INET_IDLE_TIMEOUT,
prim_state = PS},
- loop(State, Pid, []);
+ loop(State, Parent, []).
-start_it("efile", Id, Pid, _Hosts) ->
- process_flag(trap_exit, true),
+start_efile(Parent) ->
{ok, Port} = prim_file:start(),
%% Check that we started in a valid directory.
case prim_file:get_cwd(Port) of
@@ -160,20 +158,14 @@ start_it("efile", Id, Pid, _Hosts) ->
erlang:display(Report),
exit({error, invalid_current_directory});
_ ->
- init_ack(Pid)
+ init_ack(Parent)
end,
- MultiGet = case erlang:system_info(thread_pool_size) of
- 0 -> false;
- _ -> true
- end,
PS = prim_init(),
State = #state {loader = efile,
- id = Id,
data = Port,
- timeout = infinity,
- multi_get = MultiGet,
+ timeout = ?EFILE_IDLE_TIMEOUT,
prim_state = PS},
- loop(State, Pid, []).
+ loop(State, Parent, []).
init_ack(Pid) ->
Pid ! {self(),ok},
@@ -198,20 +190,6 @@ get_file(File) when is_atom(File) ->
get_file(File) ->
check_file_result(get_file, File, request({get_file,File})).
--spec get_files([{atom(), string()}],
- fun((atom(),binary(),string()) -> 'ok' | {'error', atom()})) ->
- 'ok' | {'error', atom()}.
-get_files(ModFiles, Fun) ->
- case request({get_files,{ModFiles,Fun}}) of
- E = {error,_M} ->
- E;
- {error,Reason,M} ->
- check_file_result(get_files, M, {error,Reason}),
- {error,M};
- ok ->
- ok
- end.
-
-spec list_dir(Dir) -> {'ok', Filenames} | 'error' when
Dir :: string(),
Filenames :: [Filename :: string()].
@@ -250,10 +228,13 @@ set_primary_archive(File, ArchiveBin, FileInfo, ParserFun)
when is_list(File), is_binary(ArchiveBin), is_record(FileInfo, file_info) ->
request({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}).
--spec release_archives() -> 'ok' | {'error', _}.
+%% NOTE: Does not close the primary archive. Only closes all
+%% open zip files kept in the cache. Should be called before an archive
+%% file is to be removed (for example in the test suites).
-release_archives() ->
- request(release_archives).
+-spec purge_archive_cache() -> 'ok' | {'error', _}.
+purge_archive_cache() ->
+ request(purge_archive_cache).
request(Req) ->
Loader = whereis(erl_prim_loader),
@@ -310,76 +291,59 @@ check_file_result(_, _, Other) ->
%%% The main loop.
%%% --------------------------------------------------------
-loop(State, Parent, Paths) ->
+loop(St0, Parent, Paths) ->
receive
+ {Pid,{set_path,NewPaths}} when is_pid(Pid) ->
+ Pid ! {self(),ok},
+ loop(St0, Parent, to_strs(NewPaths));
{Pid,Req} when is_pid(Pid) ->
- %% erlang:display(Req),
- {Resp,State2,Paths2} =
- case Req of
- {set_path,NewPaths} ->
- {ok,State,to_strs(NewPaths)};
- {get_path,_} ->
- {{ok,Paths},State,Paths};
- {get_file,File} ->
- {Res,State1} = handle_get_file(State, Paths, File),
- {Res,State1,Paths};
- {get_files,{ModFiles,Fun}} ->
- {Res,State1} = handle_get_files(State, ModFiles, Paths, Fun),
- {Res,State1,Paths};
- {list_dir,Dir} ->
- {Res,State1} = handle_list_dir(State, Dir),
- {Res,State1,Paths};
- {read_file_info,File} ->
- {Res,State1} = handle_read_file_info(State, File),
- {Res,State1,Paths};
- {read_link_info,File} ->
- {Res,State1} = handle_read_link_info(State, File),
- {Res,State1,Paths};
- {get_cwd,[]} ->
- {Res,State1} = handle_get_cwd(State, []),
- {Res,State1,Paths};
- {get_cwd,[_]=Args} ->
- {Res,State1} = handle_get_cwd(State, Args),
- {Res,State1,Paths};
- {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} ->
- {Res,State1} =
- handle_set_primary_archive(State, File,
- ArchiveBin, FileInfo,
- ParserFun),
- {Res,State1,Paths};
- release_archives ->
- {Res,State1} = handle_release_archives(State),
- {Res,State1,Paths};
- _Other ->
- {ignore,State,Paths}
- end,
- if Resp =:= ignore -> ok;
- true -> Pid ! {self(),Resp}, ok
- end,
- if
- is_record(State2, state) ->
- loop(State2, Parent, Paths2);
- true ->
- exit({bad_state, Req, State2})
+ case handle_request(Req, Paths, St0) of
+ ignore ->
+ ok;
+ {Resp,#state{}=St1} ->
+ Pid ! {self(),Resp},
+ loop(St1, Parent, Paths);
+ {_,State2,_} ->
+ exit({bad_state,Req,State2})
end;
{'EXIT',Parent,W} ->
- _State1 = handle_stop(State),
+ _ = handle_stop(St0),
exit(W);
{'EXIT',P,W} ->
- State1 = handle_exit(State, P, W),
- loop(State1, Parent, Paths);
+ St1 = handle_exit(St0, P, W),
+ loop(St1, Parent, Paths);
_Message ->
- loop(State, Parent, Paths)
- after State#state.timeout ->
- State1 = handle_timeout(State, Parent),
- loop(State1, Parent, Paths)
+ loop(St0, Parent, Paths)
+ after St0#state.timeout ->
+ St1 = handle_timeout(St0, Parent),
+ loop(St1, Parent, Paths)
+ end.
+
+handle_request(Req, Paths, St0) ->
+ case Req of
+ {get_path,_} ->
+ {{ok,Paths},St0};
+ {get_file,File} ->
+ handle_get_file(St0, Paths, File);
+ {list_dir,Dir} ->
+ handle_list_dir(St0, Dir);
+ {read_file_info,File} ->
+ handle_read_file_info(St0, File);
+ {read_link_info,File} ->
+ handle_read_link_info(St0, File);
+ {get_cwd,[]} ->
+ handle_get_cwd(St0, []);
+ {get_cwd,[_]=Args} ->
+ handle_get_cwd(St0, Args);
+ {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} ->
+ handle_set_primary_archive(St0, File, ArchiveBin,
+ FileInfo, ParserFun);
+ purge_archive_cache ->
+ handle_purge_archive_cache(St0);
+ _ ->
+ ignore
end.
-handle_get_files(State = #state{multi_get = true}, ModFiles, Paths, Fun) ->
- ?SAFE2(efile_multi_get_file_from_port(State, ModFiles, Paths, Fun), State);
-handle_get_files(State, _ModFiles, _Paths, _Fun) -> % no multi get
- {{error,no_multi_get},State}.
-
handle_get_file(State = #state{loader = efile}, Paths, File) ->
?SAFE2(efile_get_file_from_port(State, File, Paths), State);
handle_get_file(State = #state{loader = inet}, Paths, File) ->
@@ -388,8 +352,9 @@ handle_get_file(State = #state{loader = inet}, Paths, File) ->
handle_set_primary_archive(State= #state{loader = efile}, File, ArchiveBin, FileInfo, ParserFun) ->
?SAFE2(efile_set_primary_archive(State, File, ArchiveBin, FileInfo, ParserFun), State).
-handle_release_archives(State= #state{loader = efile}) ->
- ?SAFE2(efile_release_archives(State), State).
+handle_purge_archive_cache(#state{loader = efile}=State) ->
+ prim_purge_cache(),
+ {ok,State}.
handle_list_dir(State = #state{loader = efile}, Dir) ->
?SAFE2(efile_list_dir(State, Dir), State);
@@ -430,53 +395,6 @@ handle_timeout(State = #state{loader = inet}, Parent) ->
%%% Functions which handle efile as prim_loader (default).
%%% --------------------------------------------------------
-%%% Reading many files in parallel is an optimization.
-%%% See also comment in init.erl.
-
-%% -> {ok,State} | {{error,Module},State} | {{error,Reason,Module},State}
-efile_multi_get_file_from_port(State, ModFiles, Paths, Fun) ->
- Ref = make_ref(),
- %% More than 200 processes is no gain.
- Max = erlang:min(200, erlang:system_info(thread_pool_size)),
- efile_multi_get_file_from_port2(ModFiles, 0, Max, State, Paths, Fun, Ref, ok).
-
-efile_multi_get_file_from_port2([MF | MFs], Out, Max, State, Paths, Fun, Ref, Ret) when Out < Max ->
- Self = self(),
- _Pid = spawn(fun() -> efile_par_get_file(Ref, State, MF, Paths, Self, Fun) end),
- efile_multi_get_file_from_port2(MFs, Out+1, Max, State, Paths, Fun, Ref, Ret);
-efile_multi_get_file_from_port2(MFs, Out, Max, _State, Paths, Fun, Ref, Ret) when Out > 0 ->
- receive
- {Ref, ok, State1} ->
- efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Ret);
- {Ref, {error,_Mod} = Error, State1} ->
- efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Error);
- {Ref, MF, {error,emfile,State1}} ->
- %% Max can take negative values. Out cannot.
- efile_multi_get_file_from_port2([MF | MFs], Out-1, Max-1, State1, Paths, Fun, Ref, Ret);
- {Ref, {M,_F}, {error,Error,State1}} ->
- efile_multi_get_file_from_port2(MFs, Out-1, 0, State1, Paths, Fun, Ref, {error,Error,M})
- end;
-efile_multi_get_file_from_port2(_MFs, 0, _Max, State, _Paths, _Fun, _Ref, Ret) ->
- {Ret,State}.
-
-efile_par_get_file(Ref, State, {Mod,File} = MF, Paths, Pid, Fun) ->
- %% One port for each file read in "parallel":
- case prim_file:start() of
- {ok, Port} ->
- Port0 = State#state.data,
- State1 = State#state{data = Port},
- R = case efile_get_file_from_port(State1, File, Paths) of
- {{error,Reason},State2} ->
- {Ref,MF,{error,Reason,State2}};
- {{ok,BinFile,Full},State2} ->
- %% Fun(...) -> ok | {error,Mod}
- {Ref,Fun(Mod, BinFile, Full),State2#state{data=Port0}}
- end,
- prim_file:close(Port),
- Pid ! R;
- {error, Error} ->
- Pid ! {Ref,MF,{error,Error,State}}
- end.
%% -> {{ok,BinFile,File},State} | {{error,Reason},State}
efile_get_file_from_port(State, File, Paths) ->
@@ -521,10 +439,6 @@ efile_set_primary_archive(#state{prim_state = PS} = State, File,
FileInfo, ParserFun),
{Res,State#state{prim_state = PS2}}.
-efile_release_archives(#state{prim_state = PS} = State) ->
- {Res, PS2} = prim_release_archives(PS),
- {Res,State#state{prim_state = PS2}}.
-
efile_list_dir(#state{prim_state = PS} = State, Dir) ->
{Res, PS2} = prim_list_dir(PS, Dir),
{Res, State#state{prim_state = PS2}}.
@@ -546,14 +460,9 @@ efile_exit_port(State, Port, Reason) when State#state.data =:= Port ->
efile_exit_port(State, _Port, _Reason) ->
State.
-efile_timeout_handler(#state{n_timeouts = N} = State, _Parent) ->
- if
- N =< 0 ->
- {_Res, State2} = efile_release_archives(State),
- State2#state{n_timeouts = ?N_TIMEOUTS};
- true ->
- State#state{n_timeouts = N - 1}
- end.
+efile_timeout_handler(State, _Parent) ->
+ prim_purge_cache(),
+ State.
%%% --------------------------------------------------------
%%% Functions which handle inet prim_loader
@@ -694,7 +603,7 @@ inet_get_file_from_port1(_File, [], State) ->
inet_send_and_rcv(Msg, Tag, State) when State#state.data =:= noport ->
{ok,Tcp} = find_master(State#state.hosts), %% reconnect
inet_send_and_rcv(Msg, Tag, State#state{data = Tcp,
- timeout = ?IDLE_TIMEOUT});
+ timeout = ?INET_IDLE_TIMEOUT});
inet_send_and_rcv(Msg, Tag, #state{data = Tcp, timeout = Timeout} = State) ->
prim_inet:send(Tcp, term_to_binary(Msg)),
receive
@@ -819,32 +728,19 @@ prim_init() ->
end,
cache_new(#prim_state{debug = Deb}).
-prim_release_archives(PS) ->
- debug(PS, release_archives),
- {Res, PS2} = prim_do_release_archives(PS, get(), []),
- debug(PS2, {return, Res}),
- {Res, PS2}.
-
-prim_do_release_archives(PS, [{ArchiveFile, DictVal} | KeyVals], Acc) ->
- Res =
- case DictVal of
- {primary, _PrimZip, _FI, _ParserFun} ->
- ok; % Keep primary archive
- {Cache, _FI} ->
- debug(PS, {release, cache, ArchiveFile}),
- erase(ArchiveFile),
- clear_cache(ArchiveFile, Cache)
- end,
- case Res of
- ok ->
- prim_do_release_archives(PS, KeyVals, Acc);
- {error, Reason} ->
- prim_do_release_archives(PS, KeyVals, [{ArchiveFile, Reason} | Acc])
- end;
-prim_do_release_archives(PS, [], []) ->
- {ok, PS#prim_state{primary_archive = undefined}};
-prim_do_release_archives(PS, [], Errors) ->
- {{error, Errors}, PS#prim_state{primary_archive = undefined}}.
+prim_purge_cache() ->
+ do_prim_purge_cache(get()).
+
+do_prim_purge_cache([{Key,Val}|T]) ->
+ case Val of
+ {Cache,_FI} ->
+ catch clear_cache(Key, Cache);
+ _ ->
+ ok
+ end,
+ do_prim_purge_cache(T);
+do_prim_purge_cache([]) ->
+ ok.
prim_set_primary_archive(PS, undefined, undefined, undefined, _ParserFun) ->
debug(PS, {set_primary_archive, clean}),
@@ -1287,70 +1183,62 @@ path_join([Path],Acc) ->
path_join([Path|Paths],Acc) ->
path_join(Paths,"/" ++ reverse(Path) ++ Acc).
-name_split(ArchiveFile, File0) ->
- File = absname(File0),
- do_name_split(ArchiveFile, File).
-
-do_name_split(undefined, File) ->
+name_split(undefined, File) ->
%% Ignore primary archive
- case string_split(File, init:archive_extension(), []) of
+ RevExt = reverse(init:archive_extension()),
+ case archive_split(File, RevExt, []) of
no_split ->
- %% Plain file
{file, File};
- {split, _RevArchiveBase, RevArchiveFile, []} ->
- %% Top dir in archive
- ArchiveFile = reverse(RevArchiveFile),
- {archive, ArchiveFile, []};
- {split, _RevArchiveBase, RevArchiveFile, [$/ | FileInArchive]} ->
- %% File in archive
- ArchiveFile = reverse(RevArchiveFile),
- {archive, ArchiveFile, FileInArchive};
- {split, _RevArchiveBase, _RevArchiveFile, _FileInArchive} ->
- %% False match. Assume plain file
- {file, File}
+ Archive ->
+ Archive
end;
-do_name_split(ArchiveFile, File) ->
+name_split(ArchiveFile, File0) ->
%% Look first in primary archive
- case string_match(real_path(File), ArchiveFile, []) of
+ File = absname(File0),
+ case string_match(real_path(File), ArchiveFile) of
no_match ->
%% Archive or plain file
- do_name_split(undefined, File);
- {match, _RevPrimArchiveFile, FileInArchive} ->
+ name_split(undefined, File);
+ {match, FileInArchive} ->
%% Primary archive
{archive, ArchiveFile, FileInArchive}
end.
-string_match([Char | File], [Char | Archive], RevTop) ->
- string_match(File, Archive, [Char | RevTop]);
-string_match([] = File, [], RevTop) ->
- {match, RevTop, File};
-string_match([$/ | File], [], RevTop) ->
- {match, RevTop, File};
-string_match(_File, _Archive, _RevTop) ->
+string_match([Char | File], [Char | Archive]) ->
+ string_match(File, Archive);
+string_match([] = File, []) ->
+ {match, File};
+string_match([$/ | File], []) ->
+ {match, File};
+string_match(_File, _Archive) ->
no_match.
-string_split([Char | File], [Char | Ext] = FullExt, RevTop) ->
- RevTop2 = [Char | RevTop],
- string_split2(File, Ext, RevTop, RevTop2, File, FullExt, RevTop2);
-string_split([Char | File], Ext, RevTop) ->
- string_split(File, Ext, [Char | RevTop]);
-string_split([], _Ext, _RevTop) ->
- no_split.
-
-string_split2([Char | File], [Char | Ext], RevBase, RevTop, SaveFile, SaveExt, SaveTop) ->
- string_split2(File, Ext, RevBase, [Char | RevTop], SaveFile, SaveExt, SaveTop);
-string_split2(File, [], RevBase, RevTop, _SaveFile, _SaveExt, _SaveTop) ->
- {split, RevBase, RevTop, File};
-string_split2(_, _Ext, _RevBase, _RevTop, SaveFile, SaveExt, SaveTop) ->
- string_split(SaveFile, SaveExt, SaveTop).
+archive_split("/"++File, RevExt, Acc) ->
+ case is_prefix(RevExt, Acc) of
+ false ->
+ archive_split(File, RevExt, [$/|Acc]);
+ true ->
+ ArchiveFile = absname(reverse(Acc)),
+ {archive, ArchiveFile, File}
+ end;
+archive_split([H|T], RevExt, Acc) ->
+ archive_split(T, RevExt, [H|Acc]);
+archive_split([], RevExt, Acc) ->
+ case is_prefix(RevExt, Acc) of
+ false ->
+ no_split;
+ true ->
+ ArchiveFile = absname(reverse(Acc)),
+ {archive, ArchiveFile, []}
+ end.
+
+is_prefix([H|T1], [H|T2]) -> is_prefix(T1, T2);
+is_prefix([_|_], _) -> false;
+is_prefix([], _ ) -> true.
%% Parse list of ipv4 addresses
ipv4_list([H | T]) ->
- IPV = if is_atom(H) -> ipv4_address(atom_to_list(H));
- is_list(H) -> ipv4_address(H);
- true -> {error,einal}
- end,
- case IPV of
+ case ipv4_address(H) of
{ok,IP} -> [IP | ipv4_list(T)];
_ -> ipv4_list(T)
end;
@@ -1415,8 +1303,6 @@ absname_vr([Drive, $\: | NameRest], _) ->
%% Assumes normalized name
pathtype(Name) when is_list(Name) ->
case erlang:system_info(os_type) of
- {ose, _} ->
- unix_pathtype(Name);
{unix, _} ->
unix_pathtype(Name);
{win32, _} ->
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 063b9a1f26..ab51cf385c 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -71,7 +71,8 @@
| 'milli_seconds'
| 'micro_seconds'
| 'nano_seconds'
- | 'native'.
+ | 'native'
+ | 'perf_counter'.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Native code BIF stubs and their types
@@ -469,7 +470,7 @@ check_old_code(_Module) ->
CheckResult :: boolean().
check_process_code(Pid, Module) ->
try
- erlang:check_process_code(Pid, Module, [{allow_gc, true}])
+ erts_internal:check_process_code(Pid, Module, [{allow_gc, true}])
catch
error:Error -> erlang:error(Error, [Pid, Module])
end.
@@ -484,51 +485,11 @@ check_process_code(Pid, Module) ->
CheckResult :: boolean() | aborted.
check_process_code(Pid, Module, OptionList) ->
try
- {Async, AllowGC} = get_cpc_opts(OptionList, sync, true),
- case Async of
- {async, ReqId} ->
- {priority, Prio} = erlang:process_info(erlang:self(),
- priority),
- erts_internal:request_system_task(Pid,
- Prio,
- {check_process_code,
- ReqId,
- Module,
- AllowGC}),
- async;
- sync ->
- case Pid == erlang:self() of
- true ->
- erts_internal:check_process_code(Module,
- [{allow_gc, AllowGC}]);
- false ->
- {priority, Prio} = erlang:process_info(erlang:self(),
- priority),
- ReqId = erlang:make_ref(),
- erts_internal:request_system_task(Pid,
- Prio,
- {check_process_code,
- ReqId,
- Module,
- AllowGC}),
- receive
- {check_process_code, ReqId, CheckResult} ->
- CheckResult
- end
- end
- end
+ erts_internal:check_process_code(Pid, Module, OptionList)
catch
error:Error -> erlang:error(Error, [Pid, Module, OptionList])
end.
-% gets async and allow_gc opts and verify valid option list
-get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, AllowGC) ->
- get_cpc_opts(Options, AsyncTuple, AllowGC);
-get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) ->
- get_cpc_opts(Options, Async, AllowGC);
-get_cpc_opts([], Async, AllowGC) ->
- {Async, AllowGC}.
-
%% crc32/1
-spec erlang:crc32(Data) -> non_neg_integer() when
Data :: iodata().
@@ -1387,6 +1348,7 @@ convert_time_unit(Time, FromUnit, ToUnit) ->
try
FU = case FromUnit of
native -> erts_internal:time_unit();
+ perf_counter -> erts_internal:perf_counter_unit();
nano_seconds -> 1000*1000*1000;
micro_seconds -> 1000*1000;
milli_seconds -> 1000;
@@ -1395,6 +1357,7 @@ convert_time_unit(Time, FromUnit, ToUnit) ->
end,
TU = case ToUnit of
native -> erts_internal:time_unit();
+ perf_counter -> erts_internal:perf_counter_unit();
nano_seconds -> 1000*1000*1000;
micro_seconds -> 1000*1000;
milli_seconds -> 1000;
@@ -1473,8 +1436,16 @@ processes() ->
%% purge_module/1
-spec purge_module(Module) -> true when
Module :: atom().
-purge_module(_Module) ->
- erlang:nif_error(undefined).
+purge_module(Module) when erlang:is_atom(Module) ->
+ case erts_code_purger:purge(Module) of
+ {false, _} ->
+ erlang:error(badarg, [Module]);
+ {true, _} ->
+ true
+ end;
+purge_module(Arg) ->
+ erlang:error(badarg, [Arg]).
+
%% put/2
-spec put(Key, Val) -> term() when
@@ -2036,12 +2007,21 @@ nodes(_Arg) ->
| eof
| {parallelism, Boolean :: boolean()}
| hide.
-open_port(_PortName,_PortSettings) ->
- erlang:nif_error(undefined).
+open_port(PortName, PortSettings) ->
+ case case erts_internal:open_port(PortName, PortSettings) of
+ Ref when erlang:is_reference(Ref) -> receive {Ref, Res} -> Res end;
+ Res -> Res
+ end of
+ Port when erlang:is_port(Port) -> Port;
+ Error -> erlang:error(Error, [PortName, PortSettings])
+ end.
-type priority_level() ::
low | normal | high | max.
+-type message_queue_data() ::
+ off_heap | on_heap | mixed.
+
-spec process_flag(trap_exit, Boolean) -> OldBoolean when
Boolean :: boolean(),
OldBoolean :: boolean();
@@ -2054,6 +2034,9 @@ open_port(_PortName,_PortSettings) ->
(min_bin_vheap_size, MinBinVHeapSize) -> OldMinBinVHeapSize when
MinBinVHeapSize :: non_neg_integer(),
OldMinBinVHeapSize :: non_neg_integer();
+ (message_queue_data, MQD) -> OldMQD when
+ MQD :: message_queue_data(),
+ OldMQD :: message_queue_data();
(priority, Level) -> OldLevel when
Level :: priority_level(),
OldLevel :: priority_level();
@@ -2080,6 +2063,7 @@ process_flag(_Flag, _Value) ->
dictionary |
error_handler |
garbage_collection |
+ garbage_collection_info |
group_leader |
heap_size |
initial_call |
@@ -2092,6 +2076,7 @@ process_flag(_Flag, _Value) ->
min_bin_vheap_size |
monitored_by |
monitors |
+ message_queue_data |
priority |
reductions |
registered_name |
@@ -2119,6 +2104,7 @@ process_flag(_Flag, _Value) ->
{dictionary, Dictionary :: [{Key :: term(), Value :: term()}]} |
{error_handler, Module :: module()} |
{garbage_collection, GCInfo :: [{atom(),non_neg_integer()}]} |
+ {garbage_collection_info, GCInfo :: [{atom(),non_neg_integer()}]} |
{group_leader, GroupLeader :: pid()} |
{heap_size, Size :: non_neg_integer()} |
{initial_call, mfa()} |
@@ -2133,6 +2119,7 @@ process_flag(_Flag, _Value) ->
{monitors,
Monitors :: [{process, Pid :: pid() |
{RegName :: atom(), Node :: node()}}]} |
+ {message_queue_data, MQD :: message_queue_data()} |
{priority, Level :: priority_level()} |
{reductions, Number :: non_neg_integer()} |
{registered_name, Atom :: atom()} |
@@ -2230,6 +2217,16 @@ spawn_opt(_Tuple) ->
(io) -> {{input, Input}, {output, Output}} when
Input :: non_neg_integer(),
Output :: non_neg_integer();
+ (microstate_accounting) -> [MSAcc_Thread] | undefined when
+ MSAcc_Thread :: #{ type => MSAcc_Thread_Type,
+ id => MSAcc_Thread_Id,
+ counters => MSAcc_Counters},
+ MSAcc_Thread_Type :: scheduler | async | aux,
+ MSAcc_Thread_Id :: non_neg_integer(),
+ MSAcc_Counters :: #{ MSAcc_Thread_State => non_neg_integer() },
+ MSAcc_Thread_State :: alloc | aux | bif | busy_wait | check_io |
+ emulator | ets | gc | gc_fullsweep | nif |
+ other | port | send | sleep | timers;
(reductions) -> {Total_Reductions,
Reductions_Since_Last_Call} when
Total_Reductions :: non_neg_integer(),
@@ -2284,6 +2281,9 @@ subtract(_,_) ->
(fullsweep_after, Number) -> OldNumber when
Number :: non_neg_integer(),
OldNumber :: non_neg_integer();
+ (microstate_accounting, Action) -> OldState when
+ Action :: true | false | reset,
+ OldState :: true | false;
(min_heap_size, MinHeapSize) -> OldMinHeapSize when
MinHeapSize :: non_neg_integer(),
OldMinHeapSize :: non_neg_integer();
@@ -2445,6 +2445,7 @@ tuple_to_list(_Tuple) ->
(multi_scheduling) -> disabled | blocked | enabled;
(multi_scheduling_blockers) -> [Pid :: pid()];
(nif_version) -> string();
+ (message_queue_data) -> message_queue_data();
(otp_release) -> string();
(os_monotonic_time_source) -> [{atom(),term()}];
(os_system_time_source) -> [{atom(),term()}];
@@ -2572,14 +2573,19 @@ spawn_monitor(M, F, A) when erlang:is_atom(M),
spawn_monitor(M, F, A) ->
erlang:error(badarg, [M,F,A]).
+
+-type spawn_opt_option() ::
+ link
+ | monitor
+ | {priority, Level :: priority_level()}
+ | {fullsweep_after, Number :: non_neg_integer()}
+ | {min_heap_size, Size :: non_neg_integer()}
+ | {min_bin_vheap_size, VSize :: non_neg_integer()}
+ | {message_queue_data, MQD :: message_queue_data()}.
+
-spec spawn_opt(Fun, Options) -> pid() | {pid(), reference()} when
Fun :: function(),
- Options :: [Option],
- Option :: link | monitor
- | {priority, Level :: priority_level()}
- | {fullsweep_after, Number :: non_neg_integer()}
- | {min_heap_size, Size :: non_neg_integer()}
- | {min_bin_vheap_size, VSize :: non_neg_integer()}.
+ Options :: [spawn_opt_option()].
spawn_opt(F, O) when erlang:is_function(F) ->
spawn_opt(erlang, apply, [F, []], O);
spawn_opt({M,F}=MF, O) when erlang:is_atom(M), erlang:is_atom(F) ->
@@ -2592,12 +2598,7 @@ spawn_opt(F, O) ->
-spec spawn_opt(Node, Fun, Options) -> pid() | {pid(), reference()} when
Node :: node(),
Fun :: function(),
- Options :: [Option],
- Option :: link | monitor
- | {priority, Level :: priority_level()}
- | {fullsweep_after, Number :: non_neg_integer()}
- | {min_heap_size, Size :: non_neg_integer()}
- | {min_bin_vheap_size, VSize :: non_neg_integer()}.
+ Options :: [spawn_opt_option()].
spawn_opt(N, F, O) when N =:= erlang:node() ->
spawn_opt(F, O);
spawn_opt(N, F, O) when erlang:is_function(F) ->
@@ -2684,12 +2685,7 @@ spawn_link(N,M,F,A) ->
Module :: module(),
Function :: atom(),
Args :: [term()],
- Options :: [Option],
- Option :: link | monitor
- | {priority, Level :: priority_level()}
- | {fullsweep_after, Number :: non_neg_integer()}
- | {min_heap_size, Size :: non_neg_integer()}
- | {min_bin_vheap_size, VSize :: non_neg_integer()}.
+ Options :: [spawn_opt_option()].
spawn_opt(M, F, A, Opts) ->
case catch erlang:spawn_opt({M,F,A,Opts}) of
{'EXIT',{Reason,_}} ->
@@ -2704,12 +2700,7 @@ spawn_opt(M, F, A, Opts) ->
Module :: module(),
Function :: atom(),
Args :: [term()],
- Options :: [Option],
- Option :: link | monitor
- | {priority, Level :: priority_level()}
- | {fullsweep_after, Number :: non_neg_integer()}
- | {min_heap_size, Size :: non_neg_integer()}
- | {min_bin_vheap_size, VSize :: non_neg_integer()}.
+ Options :: [spawn_opt_option()].
spawn_opt(N, M, F, A, O) when N =:= erlang:node(),
erlang:is_atom(M), erlang:is_atom(F),
erlang:is_list(A), erlang:is_list(O) ->
diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src
index 8442aaf7e8..e53b6e5bab 100644
--- a/erts/preloaded/src/erts.app.src
+++ b/erts/preloaded/src/erts.app.src
@@ -27,6 +27,7 @@
erts_internal,
init,
otp_ring0,
+ erts_code_purger,
prim_eval,
prim_file,
prim_inet,
diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl
new file mode 100644
index 0000000000..d1e64342e0
--- /dev/null
+++ b/erts/preloaded/src/erts_code_purger.erl
@@ -0,0 +1,299 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erts_code_purger).
+
+%% Purpose : Implement system process erts_code_purger
+%% to handle code module purging.
+
+-export([start/0, purge/1, soft_purge/1]).
+
+-spec start() -> term().
+start() ->
+ register(erts_code_purger, self()),
+ process_flag(trap_exit, true),
+ loop().
+
+loop() ->
+ _ = receive
+ {purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
+ Res = do_purge(Mod),
+ From ! {reply, purge, Res, Ref};
+
+ {soft_purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
+ Res = do_soft_purge(Mod),
+ From ! {reply, soft_purge, Res, Ref};
+
+ _Other -> ignore
+ end,
+ loop().
+
+
+%% purge(Module)
+%% Kill all processes running code from *old* Module, and then purge the
+%% module. Return {WasOld, DidKill}:
+%% {false, false} there was no old module to purge
+%% {true, false} module purged, no process killed
+%% {true, true} module purged, at least one process killed
+
+purge(Mod) when is_atom(Mod) ->
+ Ref = make_ref(),
+ erts_code_purger ! {purge, Mod, self(), Ref},
+ receive
+ {reply, purge, Result, Ref} ->
+ Result
+ end.
+
+
+do_purge(Mod) ->
+ case erts_internal:copy_literals(Mod, true) of
+ false ->
+ {false, false};
+ true ->
+ DidKill = check_proc_code(erlang:processes(), Mod, true),
+ true = erts_internal:copy_literals(Mod, false),
+ WasPurged = erts_internal:purge_module(Mod),
+ {WasPurged, DidKill}
+ end.
+
+%% soft_purge(Module)
+%% Purge old code only if no procs remain that run old code.
+%% Return true in that case, false if procs remain (in this
+%% case old code is not purged)
+
+soft_purge(Mod) ->
+ Ref = make_ref(),
+ erts_code_purger ! {soft_purge, Mod, self(), Ref},
+ receive
+ {reply, soft_purge, Result, Ref} ->
+ Result
+ end.
+
+
+do_soft_purge(Mod) ->
+ case erts_internal:copy_literals(Mod, true) of
+ false ->
+ true;
+ true ->
+ DoPurge = check_proc_code(erlang:processes(), Mod, false),
+ true = erts_internal:copy_literals(Mod, false),
+ case DoPurge of
+ false ->
+ false;
+ true ->
+ erts_internal:purge_module(Mod),
+ true
+ end
+ end.
+
+%%
+%% check_proc_code(Pids, Mod, Hard) - Send asynchronous
+%% requests to all processes to perform a check_process_code
+%% operation. Each process will check their own state and
+%% reply with the result. If 'Hard' equals
+%% - true, processes that refer 'Mod' will be killed. If
+%% any processes were killed true is returned; otherwise,
+%% false.
+%% - false, and any processes refer 'Mod', false will
+%% returned; otherwise, true.
+%%
+%% Requests will be sent to all processes identified by
+%% Pids at once, but without allowing GC to be performed.
+%% Check process code operations that are aborted due to
+%% GC need, will be restarted allowing GC. However, only
+%% ?MAX_CPC_GC_PROCS outstanding operation allowing GC at
+%% a time will be allowed. This in order not to blow up
+%% memory wise.
+%%
+%% We also only allow ?MAX_CPC_NO_OUTSTANDING_KILLS
+%% outstanding kills. This both in order to avoid flooding
+%% our message queue with 'DOWN' messages and limiting the
+%% amount of memory used to keep references to all
+%% outstanding kills.
+%%
+
+%% We maybe should allow more than two outstanding
+%% GC requests, but for now we play it safe...
+-define(MAX_CPC_GC_PROCS, 2).
+-define(MAX_CPC_NO_OUTSTANDING_KILLS, 10).
+
+-record(cpc_static, {hard, module, tag}).
+
+-record(cpc_kill, {outstanding = [],
+ no_outstanding = 0,
+ waiting = [],
+ killed = false}).
+
+check_proc_code(Pids, Mod, Hard) ->
+ Tag = erlang:make_ref(),
+ CpcS = #cpc_static{hard = Hard,
+ module = Mod,
+ tag = Tag},
+ check_proc_code(CpcS, cpc_init(CpcS, Pids, 0), 0, [], #cpc_kill{}, true).
+
+check_proc_code(#cpc_static{hard = true}, 0, 0, [],
+ #cpc_kill{outstanding = [], waiting = [], killed = Killed},
+ true) ->
+ %% No outstanding requests. We did a hard check, so result is whether or
+ %% not we killed any processes...
+ Killed;
+check_proc_code(#cpc_static{hard = false}, 0, 0, [], _KillState, Success) ->
+ %% No outstanding requests and we did a soft check...
+ Success;
+check_proc_code(#cpc_static{hard = false, tag = Tag} = CpcS, NoReq0, NoGcReq0,
+ [], _KillState, false) ->
+ %% Failed soft check; just cleanup the remaining replies corresponding
+ %% to the requests we've sent...
+ {NoReq1, NoGcReq1} = receive
+ {check_process_code, {Tag, _P, GC}, _Res} ->
+ case GC of
+ false -> {NoReq0-1, NoGcReq0};
+ true -> {NoReq0, NoGcReq0-1}
+ end
+ end,
+ check_proc_code(CpcS, NoReq1, NoGcReq1, [], _KillState, false);
+check_proc_code(#cpc_static{tag = Tag} = CpcS, NoReq0, NoGcReq0, NeedGC0,
+ KillState0, Success) ->
+
+ %% Check if we should request a GC operation
+ {NoGcReq1, NeedGC1} = case NoGcReq0 < ?MAX_CPC_GC_PROCS of
+ GcOpAllowed when GcOpAllowed == false;
+ NeedGC0 == [] ->
+ {NoGcReq0, NeedGC0};
+ _ ->
+ {NoGcReq0+1, cpc_request_gc(CpcS,NeedGC0)}
+ end,
+
+ %% Wait for a cpc reply or 'DOWN' message
+ {NoReq1, NoGcReq2, Pid, Result, KillState1} = cpc_recv(Tag,
+ NoReq0,
+ NoGcReq1,
+ KillState0),
+
+ %% Check the result of the reply
+ case Result of
+ aborted ->
+ %% Operation aborted due to the need to GC in order to
+ %% determine if the process is referring the module.
+ %% Schedule the operation for restart allowing GC...
+ check_proc_code(CpcS, NoReq1, NoGcReq2, [Pid|NeedGC1], KillState1,
+ Success);
+ false ->
+ %% Process not referring the module; done with this process...
+ check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, KillState1,
+ Success);
+ true ->
+ %% Process referring the module...
+ case CpcS#cpc_static.hard of
+ false ->
+ %% ... and soft check. The whole operation failed so
+ %% no point continuing; clean up and fail...
+ check_proc_code(CpcS, NoReq1, NoGcReq2, [], KillState1,
+ false);
+ true ->
+ %% ... and hard check; schedule kill of it...
+ check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1,
+ cpc_sched_kill(Pid, KillState1), Success)
+ end;
+ 'DOWN' ->
+ %% Handled 'DOWN' message
+ check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1,
+ KillState1, Success)
+ end.
+
+cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = []} = KillState) ->
+ receive
+ {check_process_code, {Tag, Pid, GC}, Res} ->
+ cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
+ end;
+cpc_recv(Tag, NoReq, NoGcReq,
+ #cpc_kill{outstanding = [R0, R1, R2, R3, R4 | _]} = KillState) ->
+ receive
+ {'DOWN', R, process, _, _} when R == R0;
+ R == R1;
+ R == R2;
+ R == R3;
+ R == R4 ->
+ cpc_handle_down(NoReq, NoGcReq, R, KillState);
+ {check_process_code, {Tag, Pid, GC}, Res} ->
+ cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
+ end;
+cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = [R|_]} = KillState) ->
+ receive
+ {'DOWN', R, process, _, _} ->
+ cpc_handle_down(NoReq, NoGcReq, R, KillState);
+ {check_process_code, {Tag, Pid, GC}, Res} ->
+ cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
+ end.
+
+cpc_handle_down(NoReq, NoGcReq, R, #cpc_kill{outstanding = Rs,
+ no_outstanding = N} = KillState) ->
+ {NoReq, NoGcReq, undefined, 'DOWN',
+ cpc_sched_kill_waiting(KillState#cpc_kill{outstanding = cpc_list_rm(R, Rs),
+ no_outstanding = N-1})}.
+
+cpc_list_rm(R, [R|Rs]) ->
+ Rs;
+cpc_list_rm(R0, [R1|Rs]) ->
+ [R1|cpc_list_rm(R0, Rs)].
+
+cpc_handle_cpc(NoReq, NoGcReq, false, Pid, Res, KillState) ->
+ {NoReq-1, NoGcReq, Pid, Res, KillState};
+cpc_handle_cpc(NoReq, NoGcReq, true, Pid, Res, KillState) ->
+ {NoReq, NoGcReq-1, Pid, Res, KillState}.
+
+cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) ->
+ KillState;
+cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs,
+ no_outstanding = N,
+ waiting = [P|Ps]} = KillState) ->
+ R = erlang:monitor(process, P),
+ exit(P, kill),
+ KillState#cpc_kill{outstanding = [R|Rs],
+ no_outstanding = N+1,
+ waiting = Ps,
+ killed = true}.
+
+cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState)
+ when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS ->
+ KillState#cpc_kill{waiting = [Pid|Pids]};
+cpc_sched_kill(Pid,
+ #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) ->
+ R = erlang:monitor(process, Pid),
+ exit(Pid, kill),
+ KillState#cpc_kill{outstanding = [R|Rs],
+ no_outstanding = N+1,
+ killed = true}.
+
+cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) ->
+ erts_internal:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}},
+ {allow_gc, AllowGc},
+ {copy_literals, true}]).
+
+cpc_request_gc(CpcS, [Pid|Pids]) ->
+ cpc_request(CpcS, Pid, true),
+ Pids.
+
+cpc_init(_CpcS, [], NoReqs) ->
+ NoReqs;
+cpc_init(CpcS, [Pid|Pids], NoReqs) ->
+ cpc_request(CpcS, Pid, false),
+ cpc_init(CpcS, Pids, NoReqs+1).
+
+% end of check_proc_code() implementation.
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 6db77a8482..330fcc4a9c 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -31,8 +31,8 @@
-export([await_port_send_result/3]).
-export([cmp_term/2]).
--export([map_to_tuple_keys/1, map_type/1, map_hashmap_children/1]).
--export([port_command/3, port_connect/2, port_close/1,
+-export([map_to_tuple_keys/1, term_type/1, map_hashmap_children/1]).
+-export([open_port/2, port_command/3, port_connect/2, port_close/1,
port_control/3, port_call/3, port_info/1, port_info/2]).
-export([system_check/1,
@@ -40,16 +40,24 @@
-export([request_system_task/3]).
--export([check_process_code/2]).
+-export([check_process_code/3]).
+-export([copy_literals/2]).
+-export([purge_module/1]).
-export([flush_monitor_messages/3]).
-export([await_result/1, gather_io_bytes/2]).
--export([time_unit/0]).
+-export([time_unit/0, perf_counter_unit/0]).
-export([is_system_process/1]).
+-export([await_microstate_accounting_modifications/3,
+ gather_microstate_accounting_result/2]).
+
+%% Auto-import name clash
+-export([check_process_code/2]).
+
%%
%% Await result of send to port
%%
@@ -91,6 +99,13 @@ gather_io_bytes(Ref, No, InAcc, OutAcc) ->
%% Statically linked port NIFs
%%
+-spec erts_internal:open_port(PortName, PortSettings) -> Result when
+ PortName :: tuple(),
+ PortSettings :: term(),
+ Result :: port() | reference() | atom().
+open_port(_PortName, _PortSettings) ->
+ erlang:nif_error(undefined).
+
-spec erts_internal:port_command(Port, Data, OptionList) -> Result when
Port :: port() | atom(),
Data :: iodata(),
@@ -187,17 +202,86 @@ port_info(_Result, _Item) ->
-spec request_system_task(Pid, Prio, Request) -> 'ok' when
Prio :: 'max' | 'high' | 'normal' | 'low',
Request :: {'garbage_collect', term()}
- | {'check_process_code', term(), module(), boolean()},
+ | {'check_process_code', term(), module(), non_neg_integer()},
Pid :: pid().
request_system_task(_Pid, _Prio, _Request) ->
erlang:nif_error(undefined).
--spec check_process_code(Module, OptionList) -> boolean() when
+-define(ERTS_CPC_ALLOW_GC, (1 bsl 0)).
+-define(ERTS_CPC_COPY_LITERALS, (1 bsl 1)).
+
+-spec check_process_code(Module, Flags) -> boolean() when
+ Module :: module(),
+ Flags :: non_neg_integer().
+check_process_code(_Module, _Flags) ->
+ erlang:nif_error(undefined).
+
+-spec check_process_code(Pid, Module, OptionList) -> CheckResult | async when
+ Pid :: pid(),
+ Module :: module(),
+ RequestId :: term(),
+ Option :: {async, RequestId} | {allow_gc, boolean()} | {copy_literals, boolean()},
+ OptionList :: [Option],
+ CheckResult :: boolean() | aborted.
+check_process_code(Pid, Module, OptionList) ->
+ {Async, Flags} = get_cpc_opts(OptionList, sync, ?ERTS_CPC_ALLOW_GC),
+ case Async of
+ {async, ReqId} ->
+ {priority, Prio} = erlang:process_info(erlang:self(),
+ priority),
+ erts_internal:request_system_task(Pid,
+ Prio,
+ {check_process_code,
+ ReqId,
+ Module,
+ Flags}),
+ async;
+ sync ->
+ case Pid == erlang:self() of
+ true ->
+ erts_internal:check_process_code(Module, Flags);
+ false ->
+ {priority, Prio} = erlang:process_info(erlang:self(),
+ priority),
+ ReqId = erlang:make_ref(),
+ erts_internal:request_system_task(Pid,
+ Prio,
+ {check_process_code,
+ ReqId,
+ Module,
+ Flags}),
+ receive
+ {check_process_code, ReqId, CheckResult} ->
+ CheckResult
+ end
+ end
+ end.
+
+% gets async and flag opts and verify valid option list
+get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, Flags) ->
+ get_cpc_opts(Options, AsyncTuple, Flags);
+get_cpc_opts([{allow_gc, AllowGC} | Options], Async, Flags) ->
+ get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_ALLOW_GC, AllowGC));
+get_cpc_opts([{copy_literals, CopyLit} | Options], Async, Flags) ->
+ get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_COPY_LITERALS, CopyLit));
+get_cpc_opts([], Async, Flags) ->
+ {Async, Flags}.
+
+cpc_flags(OldFlags, Bit, true) ->
+ OldFlags bor Bit;
+cpc_flags(OldFlags, Bit, false) ->
+ OldFlags band (bnot Bit).
+
+-spec copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when
Module :: module(),
- Option :: {allow_gc, boolean()},
- OptionList :: [Option].
-check_process_code(_Module, _OptionList) ->
+ Bool :: boolean().
+copy_literals(_Mod, _Bool) ->
+ erlang:nif_error(undefined).
+
+-spec purge_module(Module) -> boolean() when
+ Module :: module().
+purge_module(_Module) ->
erlang:nif_error(undefined).
-spec system_check(Type) -> 'ok' when
@@ -235,12 +319,18 @@ cmp_term(_A,_B) ->
map_to_tuple_keys(_M) ->
erlang:nif_error(undefined).
-%% return the internal map type
--spec map_type(M) -> Type when
- M :: map(),
- Type :: 'flatmap' | 'hashmap' | 'hashmap_node'.
-
-map_type(_M) ->
+%% return the internal term type
+-spec term_type(T) -> Type when
+ T :: term(),
+ Type :: 'flatmap' | 'hashmap' | 'hashmap_node'
+ | 'fixnum' | 'bignum' | 'hfloat'
+ | 'list' | 'tuple' | 'export' | 'fun'
+ | 'refc_binary' | 'heap_binary' | 'sub_binary'
+ | 'reference' | 'external_reference'
+ | 'pid' | 'external_pid' | 'port' | 'external_port'
+ | 'atom' | 'catch' | 'nil'.
+
+term_type(_T) ->
erlang:nif_error(undefined).
%% return the internal hashmap sub-nodes from
@@ -278,8 +368,38 @@ flush_monitor_messages(Ref, Multi, Res) when is_reference(Ref) ->
time_unit() ->
erlang:nif_error(undefined).
+-spec erts_internal:perf_counter_unit() -> pos_integer().
+
+perf_counter_unit() ->
+ erlang:nif_error(undefined).
+
-spec erts_internal:is_system_process(Pid) -> boolean() when
Pid :: pid().
is_system_process(_Pid) ->
erlang:nif_error(undefined).
+
+-spec await_microstate_accounting_modifications(Ref, Result, Threads) -> boolean() when
+ Ref :: reference(),
+ Result :: boolean(),
+ Threads :: pos_integer().
+
+await_microstate_accounting_modifications(Ref, Result, Threads) ->
+ _ = microstate_accounting(Ref,Threads),
+ Result.
+
+-spec gather_microstate_accounting_result(Ref, Threads) -> [#{}] when
+ Ref :: reference(),
+ Threads :: pos_integer().
+
+gather_microstate_accounting_result(Ref, Threads) ->
+ microstate_accounting(Ref, Threads).
+
+microstate_accounting(_Ref, 0) ->
+ [];
+microstate_accounting(Ref, Threads) ->
+ receive
+ Ref -> microstate_accounting(Ref, Threads - 1);
+ {Ref, Res} ->
+ [Res | microstate_accounting(Ref, Threads - 1)]
+ end.
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
index 0ad5824ad1..ed65c57c0d 100644
--- a/erts/preloaded/src/init.erl
+++ b/erts/preloaded/src/init.erl
@@ -23,7 +23,6 @@
%% a local file or distributed from another erlang node.
%%
%% Flags:
-%% -id Identity : identity of the system.
%% -boot File : Absolute file name of the boot script.
%% -boot_var Var Value
%% : $Var in the boot script is expanded to
@@ -75,6 +74,19 @@
subscribed = []}).
-type state() :: #state{}.
+%% Data for eval_script/2.
+-record(es,
+ {init,
+ debug,
+ path,
+ pa,
+ pz,
+ path_choice,
+ prim_load,
+ load_mode,
+ vars
+ }).
+
-define(ON_LOAD_HANDLER, init__boot__on_load_handler).
debug(false, _) -> ok;
@@ -169,8 +181,7 @@ boot(BootArgs) ->
process_flag(trap_exit, true),
{Start0,Flags,Args} = parse_boot_args(BootArgs),
Start = map(fun prepare_run_args/1, Start0),
- Flags0 = flags_to_atoms_again(Flags),
- boot(Start,Flags0,Args).
+ boot(Start, Flags, Args).
prepare_run_args({eval, [Expr]}) ->
{eval,Expr};
@@ -202,16 +213,6 @@ map(_F, []) ->
map(F, [X|Rest]) ->
[F(X) | map(F, Rest)].
-flags_to_atoms_again([]) ->
- [];
-flags_to_atoms_again([{F0,L0}|Rest]) ->
- L = L0,
- F = b2a(F0),
- [{F,L}|flags_to_atoms_again(Rest)];
-flags_to_atoms_again([{F0}|Rest]) ->
- F = b2a(F0),
- [{F}|flags_to_atoms_again(Rest)].
-
-spec code_path_choice() -> 'relaxed' | 'strict'.
code_path_choice() ->
case get_argument(code_path_choice) of
@@ -337,7 +338,7 @@ boot_loop(BootPid, State) ->
end.
ensure_loaded(Module, Loaded) ->
- File = concat([Module,objfile_extension()]),
+ File = atom_to_list(Module) ++ objfile_extension(),
case catch load_mod(Module,File) of
{ok, FullName} ->
{{module, Module}, [{Module, FullName}|Loaded]};
@@ -451,9 +452,9 @@ do_handle_msg(Msg,State) ->
%%% -------------------------------------------------
make_permanent(Boot,Config,Flags0,State) ->
- case set_flag('-boot',Boot,Flags0) of
+ case set_flag(boot, Boot, Flags0) of
{ok,Flags1} ->
- case set_flag('-config',Config,Flags1) of
+ case set_flag(config, Config, Flags1) of
{ok,Flags} ->
{ok,State#state{flags = Flags}};
Error ->
@@ -635,9 +636,9 @@ unload(_) ->
do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())).
do_unload([M|Mods]) ->
- catch erlang:purge_module(M),
+ catch erts_internal:purge_module(M),
catch erlang:delete_module(M),
- catch erlang:purge_module(M),
+ catch erts_internal:purge_module(M),
do_unload(Mods);
do_unload([]) ->
purge_all_hipe_refs(),
@@ -691,17 +692,15 @@ sleep(T) -> receive after T -> ok end.
%%% The loader shall run for ever!
%%% -------------------------------------------------
-start_prim_loader(Init,Id,Pgm,Nodes,Path,{Pa,Pz}) ->
- case erl_prim_loader:start(Id,Pgm,Nodes) of
- {ok,Pid} when Path =:= false ->
- InitPath = append(Pa,["."|Pz]),
- erl_prim_loader:set_path(InitPath),
- add_to_kernel(Init,Pid),
- Pid;
+start_prim_loader(Init, Path0, {Pa,Pz}) ->
+ Path = case Path0 of
+ false -> Pa ++ ["."|Pz];
+ _ -> Path0
+ end,
+ case erl_prim_loader:start() of
{ok,Pid} ->
erl_prim_loader:set_path(Path),
- add_to_kernel(Init,Pid),
- Pid;
+ add_to_kernel(Init, Pid);
{error,Reason} ->
erlang:display({"cannot start loader",Reason}),
exit(Reason)
@@ -715,13 +714,6 @@ add_to_kernel(Init,Pid) ->
ok
end.
-prim_load_flags(Flags) ->
- PortPgm = get_flag('-loader',Flags,<<"efile">>),
- Hosts = get_flag_list('-hosts', Flags, []),
- Id = get_flag('-id',Flags,none),
- Path = get_flag_list('-path',Flags,false),
- {PortPgm, Hosts, Id, Path}.
-
%%% -------------------------------------------------
%%% The boot process fetches a boot script and loads
%%% all modules specified and starts spec. processes.
@@ -734,24 +726,23 @@ do_boot(Flags,Start) ->
do_boot(Init,Flags,Start) ->
process_flag(trap_exit,true),
- {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags),
- Root = b2s(get_flag('-root',Flags)),
- PathFls = path_flags(Flags),
- Pgm = b2s(Pgm0),
- _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes),
- bs2ss(Path),PathFls),
+ Root = get_root(Flags),
+ Path = get_flag_list(path, Flags, false),
+ {Pa,Pz} = PathFls = path_flags(Flags),
+ start_prim_loader(Init, bs2ss(Path), PathFls),
BootFile = bootfile(Flags,Root),
BootList = get_boot(BootFile,Root),
- LoadMode = b2a(get_flag('-mode',Flags,false)),
- Deb = b2a(get_flag('-init_debug',Flags,false)),
+ LoadMode = b2a(get_flag(mode, Flags, false)),
+ Deb = b2a(get_flag(init_debug, Flags, false)),
catch ?ON_LOAD_HANDLER ! {init_debug_flag,Deb},
- BootVars = get_flag_args('-boot_var',Flags),
- ParallelLoad =
- (Pgm =:= "efile") and (erlang:system_info(thread_pool_size) > 0),
+ BootVars = get_boot_vars(Root, Flags),
PathChoice = code_path_choice(),
- eval_script(BootList,Init,PathFls,{Root,BootVars},Path,
- {true,LoadMode,ParallelLoad},Deb,PathChoice),
+ Es = #es{init=Init,debug=Deb,path=Path,pa=Pa,pz=Pz,
+ path_choice=PathChoice,
+ prim_load=true,load_mode=LoadMode,
+ vars=BootVars},
+ eval_script(BootList, Es),
%% To help identifying Purify windows that pop up,
%% print the node name into the Purify log.
@@ -759,21 +750,43 @@ do_boot(Init,Flags,Start) ->
start_em(Start).
+get_root(Flags) ->
+ case get_argument(root, Flags) of
+ {ok,[[Root]]} ->
+ Root;
+ _ ->
+ exit(no_or_multiple_root_variables)
+ end.
+
+get_boot_vars(Root, Flags) ->
+ BootVars = get_boot_vars_1(#{}, Flags),
+ RootKey = <<"ROOT">>,
+ BootVars#{RootKey=>Root}.
+
+get_boot_vars_1(Vars, [{boot_var,[Key,Value]}|T]) ->
+ get_boot_vars_1(Vars#{Key=>Value}, T);
+get_boot_vars_1(_, [{boot_var,_}|_]) ->
+ exit(invalid_boot_var_argument);
+get_boot_vars_1(Vars, [_|T]) ->
+ get_boot_vars_1(Vars, T);
+get_boot_vars_1(Vars, []) ->
+ Vars.
+
bootfile(Flags,Root) ->
- b2s(get_flag('-boot',Flags,concat([Root,"/bin/start"]))).
+ b2s(get_flag(boot, Flags, Root++"/bin/start")).
path_flags(Flags) ->
- Pa = append(reverse(get_flag_args('-pa',Flags))),
- Pz = append(get_flag_args('-pz',Flags)),
+ Pa = append(reverse(get_flag_args(pa, Flags))),
+ Pz = append(get_flag_args(pz, Flags)),
{bs2ss(Pa),bs2ss(Pz)}.
get_boot(BootFile0,Root) ->
- BootFile = concat([BootFile0,".boot"]),
+ BootFile = BootFile0 ++ ".boot",
case get_boot(BootFile) of
{ok, CmdList} ->
CmdList;
not_found -> %% Check for default.
- BootF = concat([Root,"/bin/",BootFile]),
+ BootF = Root ++ "/bin/" ++ BootFile,
case get_boot(BootF) of
{ok, CmdList} ->
CmdList;
@@ -807,93 +820,67 @@ get_boot(BootFile) ->
%% boot process hangs (we want to ensure syncronicity).
%%
-eval_script([{progress,Info}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
- debug(Deb,{progress,Info}),
+eval_script([{progress,Info}=Progress|T], #es{debug=Deb}=Es) ->
+ debug(Deb, Progress),
init ! {self(),progress,Info},
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([{preLoaded,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([{path,Path}|CfgL],Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice) ->
+ eval_script(T, Es);
+eval_script([{preLoaded,_}|T], #es{}=Es) ->
+ eval_script(T, Es);
+eval_script([{path,Path}|T], #es{path=false,pa=Pa,pz=Pz,
+ path_choice=PathChoice,
+ vars=Vars}=Es) ->
RealPath0 = make_path(Pa, Pz, Path, Vars),
RealPath = patch_path(RealPath0, PathChoice),
erl_prim_loader:set_path(RealPath),
- eval_script(CfgL,Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice);
-eval_script([{path,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
+ eval_script(T, Es);
+eval_script([{path,_}|T], #es{}=Es) ->
%% Ignore, use the command line -path flag.
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,embedded,Par},Deb,PathChoice) ->
- eval_script(CfgL,Init,PathFs,Vars,P,{true,embedded,Par},Deb,PathChoice);
-eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,E,Par},Deb,PathChoice) ->
- eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice);
-eval_script([{primLoad,Mods}|CfgL],Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice)
+ eval_script(T, Es);
+eval_script([{kernel_load_completed}|T], #es{load_mode=Mode}=Es0) ->
+ Es = case Mode of
+ embedded -> Es0;
+ _ -> Es0#es{prim_load=false}
+ end,
+ eval_script(T, Es);
+eval_script([{primLoad,[Mod]}|T], #es{prim_load=true}=Es) ->
+ %% Common special case (loading of error_handler). Nothing
+ %% to gain by parallel loading.
+ File = atom_to_list(Mod) ++ objfile_extension(),
+ {ok,Full} = load_mod(Mod, File),
+ init ! {self(),loaded,{Mod,Full}}, % Tell init about loaded module
+ eval_script(T, Es);
+eval_script([{primLoad,Mods}|T], #es{init=Init,prim_load=PrimLoad}=Es)
when is_list(Mods) ->
- if
- Par =:= true ->
- par_load_modules(Mods,Init);
+ case PrimLoad of
true ->
- load_modules(Mods)
+ load_modules(Mods, Init);
+ false ->
+ %% Do not load now, code_server does that dynamically!
+ ok
end,
- eval_script(CfgL,Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice);
-eval_script([{primLoad,_Mods}|CfgL],Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice) ->
- %% Do not load now, code_server does that dynamically!
- eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice);
-eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|CfgL],Init,
- PathFs,Vars,P,Ph,Deb,PathChoice) ->
- debug(Deb,{start,Server}),
- start_in_kernel(Server,Mod,Fun,Args,Init),
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([{apply,{Mod,Fun,Args}}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
- debug(Deb,{apply,{Mod,Fun,Args}}),
- apply(Mod,Fun,Args),
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([],_,_,_,_,_,_,_) ->
+ eval_script(T, Es);
+eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|T],
+ #es{init=Init,debug=Deb}=Es) ->
+ debug(Deb, {start,Server}),
+ start_in_kernel(Server, Mod, Fun, Args, Init),
+ eval_script(T, Es);
+eval_script([{apply,{Mod,Fun,Args}}=Apply|T], #es{debug=Deb}=Es) ->
+ debug(Deb, Apply),
+ apply(Mod, Fun, Args),
+ eval_script(T, Es);
+eval_script([], #es{}) ->
ok;
-eval_script(What,_,_,_,_,_,_,_) ->
+eval_script(What, #es{}) ->
exit({'unexpected command in bootfile',What}).
-load_modules([Mod|Mods]) ->
- File = concat([Mod,objfile_extension()]),
+load_modules([Mod|Mods], Init) ->
+ File = atom_to_list(Mod) ++ objfile_extension(),
{ok,Full} = load_mod(Mod,File),
- init ! {self(),loaded,{Mod,Full}}, %% Tell init about loaded module
- load_modules(Mods);
-load_modules([]) ->
+ Init ! {self(),loaded,{Mod,Full}}, %Tell init about loaded module
+ load_modules(Mods, Init);
+load_modules([], _) ->
ok.
-%%% An optimization: erl_prim_loader gets the chance of loading many
-%%% files in parallel, using threads. This will reduce the seek times,
-%%% and loaded code can be processed while other threads are waiting
-%%% for the disk. The optimization is not tried unless the loader is
-%%% "efile" and there is a non-empty pool of threads.
-%%%
-%%% Many threads are needed to get a good result, so it would be
-%%% beneficial to load several applications in parallel. However,
-%%% measurements show that the file system handles one directory at a
-%%% time, regardless if parallel threads are created for files on
-%%% several directories (a guess: writing the meta information when
-%%% the file was last read ('mtime'), forces the file system to sync
-%%% between directories).
-
-par_load_modules(Mods,Init) ->
- Ext = objfile_extension(),
- ModFiles = [{Mod,concat([Mod,Ext])} || Mod <- Mods,
- not erlang:module_loaded(Mod)],
- Self = self(),
- Fun = fun(Mod, BinCode, FullName) ->
- case catch load_mod_code(Mod, BinCode, FullName) of
- {ok, _} ->
- Init ! {Self,loaded,{Mod,FullName}},
- ok;
- _EXIT ->
- {error, Mod}
- end
- end,
- case erl_prim_loader:get_files(ModFiles, Fun) of
- ok ->
- ok;
- {error,Mod} ->
- exit({'cannot load',Mod,get_files})
- end.
-
make_path(Pa, Pz, Path, Vars) ->
append([Pa,append([fix_path(Path,Vars),Pz])]).
@@ -908,34 +895,25 @@ fix_path([Path|Ps], Vars) ->
fix_path(_, _) ->
[].
-add_var("$ROOT/" ++ Path, {Root,_}) ->
- concat([Root, "/", Path]);
-add_var([$$|Path0], {_,VarList}) ->
- {Var,Path} = extract_var(Path0,[]),
- Value = b2s(get_var_value(list_to_binary(Var),VarList)),
- concat([Value, "/", Path]);
-add_var(Path, _) ->
+add_var("$"++Path0, Vars) ->
+ {Var,Path} = extract_var(Path0, []),
+ Key = list_to_binary(Var),
+ case Vars of
+ #{Key:=Value0} ->
+ Value = b2s(Value0),
+ Value ++ "/" ++ Path;
+ _ ->
+ Error0 = "cannot expand $" ++ Var ++ " in bootfile",
+ Error = list_to_atom(Error0),
+ exit(Error)
+ end;
+add_var(Path, _) ->
Path.
extract_var([$/|Path],Var) -> {reverse(Var),Path};
extract_var([H|T],Var) -> extract_var(T,[H|Var]);
extract_var([],Var) -> {reverse(Var),[]}.
-%% get_var_value(Var, [Vars]) where Vars == [atom()]
-get_var_value(Var,[Vars|VarList]) ->
- case get_var_val(Var,Vars) of
- {ok, Value} ->
- Value;
- _ ->
- get_var_value(Var,VarList)
- end;
-get_var_value(Var,[]) ->
- exit(list_to_atom(concat(["cannot expand \$", Var, " in bootfile"]))).
-
-get_var_val(Var,[Var,Value|_]) -> {ok, Value};
-get_var_val(Var,[_,_|Vars]) -> get_var_val(Var,Vars);
-get_var_val(_,_) -> false.
-
patch_path(Dirs, strict) ->
Dirs;
patch_path(Dirs, relaxed) ->
@@ -1049,18 +1027,10 @@ start_it({eval,Bin}) ->
{value, _Value, _Bs} = erl_eval:exprs(Expr, erl_eval:new_bindings()),
ok;
start_it([_|_]=MFA) ->
- Ref = make_ref(),
- case catch {Ref,case MFA of
- [M] -> M:start();
- [M,F] -> M:F();
- [M,F|Args] -> M:F(Args) % Args is a list
- end} of
- {Ref,R} ->
- R;
- {'EXIT',Reason} ->
- exit(Reason);
- Other ->
- throw(Other)
+ case MFA of
+ [M] -> M:start();
+ [M,F] -> M:F();
+ [M,F|Args] -> M:F(Args) % Args is a list
end.
%%
@@ -1102,7 +1072,7 @@ load_mod_code(Mod, BinCode, FullName) ->
%% --------------------------------------------------------
shutdown_timer(Flags) ->
- case get_flag('-shutdown_time',Flags,infinity) of
+ case get_flag(shutdown_time, Flags, infinity) of
infinity ->
self();
Time ->
@@ -1152,14 +1122,10 @@ parse_boot_args([B|Bs], Ss, Fs, As) ->
eval_arg ->
{Expr,Rest} = get_args(Bs, []),
parse_boot_args(Rest, [{eval, Expr}|Ss], Fs, As);
- flag ->
+ {flag,A} ->
{F,Rest} = get_args(Bs, []),
- Fl = case F of
- [] -> [B];
- FF -> [B,FF]
- end,
- parse_boot_args(Rest, Ss,
- [list_to_tuple(Fl)|Fs], As);
+ Fl = {A,F},
+ parse_boot_args(Rest, Ss, [Fl|Fs], As);
arg ->
parse_boot_args(Bs, Ss, Fs, [B|As]);
end_args ->
@@ -1173,12 +1139,8 @@ check(<<"-s">>) -> start_arg;
check(<<"-run">>) -> start_arg2;
check(<<"-eval">>) -> eval_arg;
check(<<"--">>) -> end_args;
-check(X) when is_binary(X) ->
- case binary_to_list(X) of
- [$-|_Rest] -> flag;
- _Chars -> arg %Even empty atoms
- end;
-check(_X) -> arg. %This should never occur
+check(<<"-",Flag/binary>>) -> {flag,b2a(Flag)};
+check(_) -> arg.
get_args([B|Bs], As) ->
case check(B) of
@@ -1187,7 +1149,7 @@ get_args([B|Bs], As) ->
start_arg2 -> {reverse(As), [B|Bs]};
eval_arg -> {reverse(As), [B|Bs]};
end_args -> {reverse(As), Bs};
- flag -> {reverse(As), [B|Bs]};
+ {flag,_} -> {reverse(As), [B|Bs]};
arg ->
get_args(Bs, [B|As])
end;
@@ -1199,44 +1161,28 @@ get_args([], As) -> {reverse(As),[]}.
%% atom() if a single arg was given.
%% list(atom()) if several args were given.
%%
-get_flag(F,Flags,Default) ->
- case catch get_flag(F,Flags) of
- {'EXIT',_} ->
- Default;
- Value ->
- Value
- end.
-
-get_flag(F,Flags) ->
- case search(F,Flags) of
- {value,{F,[V]}} ->
+get_flag(F, Flags, Default) ->
+ case lists:keyfind(F, 1, Flags) of
+ {F,[]} ->
+ true;
+ {F,[V]} ->
V;
- {value,{F,V}} ->
+ {F,V} ->
V;
- {value,{F}} -> % Flag given!
- true;
_ ->
- exit(list_to_atom(concat(["no ",F," flag"])))
+ Default
end.
%%
%% Internal get_flag function, with default value.
%% Return: list(atom())
%%
-get_flag_list(F,Flags,Default) ->
- case catch get_flag_list(F,Flags) of
- {'EXIT',_} ->
- Default;
- Value ->
- Value
- end.
-
-get_flag_list(F,Flags) ->
- case search(F,Flags) of
- {value,{F,V}} ->
+get_flag_list(F, Flags, Default) ->
+ case lists:keyfind(F, 1, Flags) of
+ {F,[_|_]=V} ->
V;
_ ->
- exit(list_to_atom(concat(["no ",F," flag"])))
+ Default
end.
%%
@@ -1246,21 +1192,15 @@ get_flag_list(F,Flags) ->
%%
get_flag_args(F,Flags) -> get_flag_args(F,Flags,[]).
-get_flag_args(F,[{F,V}|Flags],Acc) when is_list(V) ->
- get_flag_args(F,Flags,[V|Acc]);
get_flag_args(F,[{F,V}|Flags],Acc) ->
- get_flag_args(F,Flags,[[V]|Acc]);
+ get_flag_args(F,Flags,[V|Acc]);
get_flag_args(F,[_|Flags],Acc) ->
get_flag_args(F,Flags,Acc);
get_flag_args(_,[],Acc) ->
reverse(Acc).
get_arguments([{F,V}|Flags]) ->
- [$-|Fl] = atom_to_list(F),
- [{list_to_atom(Fl),to_strings(V)}|get_arguments(Flags)];
-get_arguments([{F}|Flags]) ->
- [$-|Fl] = atom_to_list(F),
- [{list_to_atom(Fl),[]}|get_arguments(Flags)];
+ [{F,to_strings(V)}|get_arguments(Flags)];
get_arguments([]) ->
[].
@@ -1268,44 +1208,26 @@ to_strings([H|T]) when is_atom(H) -> [atom_to_list(H)|to_strings(T)];
to_strings([H|T]) when is_binary(H) -> [b2s(H)|to_strings(T)];
to_strings([]) -> [].
-get_argument(Arg,Flags) ->
- Args = get_arguments(Flags),
- case get_argument1(Arg,Args) of
- [] ->
- error;
- Value ->
- {ok,Value}
+get_argument(Arg, Flags) ->
+ case get_argument1(Arg, Flags) of
+ [] -> error;
+ Value -> {ok,Value}
end.
-get_argument1(Arg,[{Arg,V}|Args]) ->
- [V|get_argument1(Arg,Args)];
-get_argument1(Arg,[_|Args]) ->
- get_argument1(Arg,Args);
-get_argument1(_,[]) ->
+get_argument1(Arg, [{Arg,V}|Args]) ->
+ [to_strings(V)|get_argument1(Arg, Args)];
+get_argument1(Arg, [_|Args]) ->
+ get_argument1(Arg, Args);
+get_argument1(_, []) ->
[].
set_argument([{Flag,_}|Flags],Flag,Value) ->
[{Flag,[Value]}|Flags];
-set_argument([{Flag}|Flags],Flag,Value) ->
- [{Flag,[Value]}|Flags];
set_argument([Item|Flags],Flag,Value) ->
[Item|set_argument(Flags,Flag,Value)];
set_argument([],Flag,Value) ->
[{Flag,[Value]}].
-concat([A|T]) when is_atom(A) ->
- atom_to_list(A) ++ concat(T);
-concat([C|T]) when is_integer(C), 0 =< C, C =< 255 ->
- [C|concat(T)];
-concat([Bin|T]) when is_binary(Bin) ->
- binary_to_list(Bin) ++ concat(T);
-concat([S|T]) ->
- S ++ concat(T);
-concat([]) ->
- [].
-
-append(L, Z) -> L ++ Z.
-
append([E]) -> E;
append([H|T]) ->
H ++ append(T);
@@ -1320,13 +1242,6 @@ reverse([A, B]) ->
reverse([A, B | L]) ->
lists:reverse(L, [B, A]). % BIF
-search(Key, [H|_T]) when is_tuple(H), element(1, H) =:= Key ->
- {value, H};
-search(Key, [_|T]) ->
- search(Key, T);
-search(_Key, []) ->
- false.
-
-spec objfile_extension() -> nonempty_string().
objfile_extension() ->
".beam".
diff --git a/erts/test/Makefile b/erts/test/Makefile
index 5263d8cd4f..a01d67e34f 100644
--- a/erts/test/Makefile
+++ b/erts/test/Makefile
@@ -54,7 +54,7 @@ RELSYSDIR = $(RELEASE_PATH)/system_test
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
# ----------------------------------------------------
# Targets
diff --git a/erts/test/erl_print_SUITE.erl b/erts/test/erl_print_SUITE.erl
index 3b0c083702..f0fee49024 100644
--- a/erts/test/erl_print_SUITE.erl
+++ b/erts/test/erl_print_SUITE.erl
@@ -40,7 +40,7 @@
-export([erlang_display/1, integer/1, float/1,
string/1, character/1, snprintf/1, quote/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl
index c21064fd3f..7e44be1fe0 100644
--- a/erts/test/erlc_SUITE.erl
+++ b/erts/test/erlc_SUITE.erl
@@ -27,7 +27,7 @@
compile_mib/1, good_citizen/1, deep_cwd/1, arg_overflow/1,
make_dep_options/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl
index 9279872d25..6440cbf0d7 100644
--- a/erts/test/erlexec_SUITE.erl
+++ b/erts/test/erlexec_SUITE.erl
@@ -38,7 +38,7 @@
-export([args_file/1, evil_args_file/1, env/1, args_file_env/1, otp_7461/1, otp_7461_remote/1, otp_8209/1, zdbbl_dist_buf_busy_limit/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(Case, Config) ->
diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl
index 4a40dbb11e..8ad2a32278 100644
--- a/erts/test/ethread_SUITE.erl
+++ b/erts/test/ethread_SUITE.erl
@@ -51,7 +51,7 @@
atomic/1,
dw_atomic_massage/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
tests() ->
[create_join_thread,
@@ -123,38 +123,6 @@ try_lock_mutex(suite) ->
try_lock_mutex(Config) ->
run_case(Config, "try_lock_mutex", "").
-%% Remove dead code?
-
-% wd_dispatch(P) ->
-% receive
-% bye ->
-% ?line true = port_command(P, "-1 "),
-% ?line bye;
-% L when is_list(L) ->
-% ?line true = port_command(P, L),
-% ?line wd_dispatch(P)
-% end.
-%
-% watchdog(Port) ->
-% ?line process_flag(priority, max),
-% ?line receive after 500 -> ok end,
-%
-% ?line random:seed(),
-% ?line true = port_command(Port, "0 "),
-% ?line lists:foreach(fun (T) ->
-% erlang:send_after(T,
-% self(),
-% integer_to_list(T)
-% ++ " ")
-% end,
-% lists:usort(lists:map(fun (_) ->
-% random:uniform(4500)+500
-% end,
-% lists:duplicate(50,0)))),
-% ?line erlang:send_after(5100, self(), bye),
-%
-% wd_dispatch(Port).
-
cond_wait(doc) ->
["Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast."];
cond_wait(suite) ->
diff --git a/erts/test/ignore_cores.erl b/erts/test/ignore_cores.erl
index 13f34cd10f..e40b91392c 100644
--- a/erts/test/ignore_cores.erl
+++ b/erts/test/ignore_cores.erl
@@ -28,7 +28,7 @@
-module(ignore_cores).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]).
diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl
index b380b064bd..d6df1aab6b 100644
--- a/erts/test/install_SUITE.erl
+++ b/erts/test/install_SUITE.erl
@@ -52,7 +52,7 @@
-define(DEFAULT_TIMEOUT, ?t:minutes(1)).
-define(JOIN(A,B,C), filename:join(A, B, C)).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record(inst, {mkdirs = true,
symlinks = true,
diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl
index dbae8df7fe..1ddaaaaeb5 100644
--- a/erts/test/nt_SUITE.erl
+++ b/erts/test/nt_SUITE.erl
@@ -20,7 +20,7 @@
%%% Purpose: Test NT specific utilities
-module(nt_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl
index 69a0d19719..6777c205b0 100644
--- a/erts/test/otp_SUITE.erl
+++ b/erts/test/otp_SUITE.erl
@@ -27,7 +27,7 @@
call_to_size_1/1,call_to_now_0/1,strong_components/1,
erl_file_encoding/1,xml_file_encoding/1,runtime_dependencies/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-import(lists, [filter/2,foldl/3,foreach/2]).
@@ -290,7 +290,7 @@ call_to_deprecated(Config) when is_list(Config) ->
call_to_size_1(Config) when is_list(Config) ->
%% Applications that do not call erlang:size/1:
Apps = [asn1,compiler,debugger,kernel,observer,parsetools,
- runtime_tools,stdlib,tools,webtool],
+ runtime_tools,stdlib,tools],
not_recommended_calls(Config, Apps, {erlang,size,1}).
call_to_now_0(Config) when is_list(Config) ->
@@ -298,12 +298,14 @@ call_to_now_0(Config) when is_list(Config) ->
Apps = [asn1,common_test,compiler,debugger,dialyzer,
gs,kernel,mnesia,observer,parsetools,reltool,
runtime_tools,sasl,stdlib,syntax_tools,
- test_server,tools,webtool],
+ test_server,tools],
not_recommended_calls(Config, Apps, {erlang,now,0}).
-not_recommended_calls(Config, Apps, MFA) ->
+not_recommended_calls(Config, Apps0, MFA) ->
Server = ?config(xref_server, Config),
+ Apps = [App || App <- Apps0, is_present_application(App, Server)],
+
Fs = [MFA],
Q1 = io_lib:format("E || ~p : Fun", [Fs]),
@@ -337,11 +339,28 @@ not_recommended_calls(Config, Apps, MFA) ->
end,
case CallsToMFA of
[] ->
- ok;
+ SkippedApps = ordsets:subtract(ordsets:from_list(Apps0),
+ ordsets:from_list(Apps)),
+ case SkippedApps of
+ [] ->
+ ok;
+ _ ->
+ AppStrings = [atom_to_list(A) || A <- SkippedApps],
+ Mess = io_lib:format("Application(s) not present: ~s\n",
+ [string:join(AppStrings, ", ")]),
+ {comment, Mess}
+ end;
_ ->
?t:fail({length(CallsToMFA),calls_to_size_1})
end.
+is_present_application(Name, Server) ->
+ Q = io_lib:format("~w : App", [Name]),
+ case xref:q(Server, lists:flatten(Q)) of
+ {ok,[Name]} -> true;
+ {error,_,_} -> false
+ end.
+
strong_components(Config) when is_list(Config) ->
Server = ?config(xref_server, Config),
?line {ok,Cs} = xref:q(Server, "components AE"),
diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl
index 328477d870..e3c563d3d9 100644
--- a/erts/test/run_erl_SUITE.erl
+++ b/erts/test/run_erl_SUITE.erl
@@ -26,7 +26,7 @@
basic/1,heavy/1,heavier/1,defunct/1]).
-export([ping_me_back/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(_Case, Config) ->
Dog = ?t:timetrap(?t:minutes(2)),
@@ -141,12 +141,10 @@ heavier_1(Config) ->
?line ToErl = open_port({spawn,"to_erl "++Pipe}, []),
io:format("ToErl = ~p\n", [ToErl]),
- X = 1,
- Y = 555,
- Z = 42,
- ?line random:seed(X, Y, Z),
- SeedCmd = lists:flatten(io_lib:format("random:seed(~p, ~p, ~p). \r\n",
- [X,Y,Z])),
+ Seed = {1,555,42},
+ rand:seed(exsplus, Seed),
+ SeedCmd = lists:flatten(io_lib:format("rand:seed(exsplus, ~p). \r\n",
+ [Seed])),
?line io:format("~p\n", [SeedCmd]),
?line erlang:port_command(ToErl, SeedCmd),
@@ -157,9 +155,9 @@ heavier_1(Config) ->
"F = fun(F,0) -> ok; "++
"(F,N) -> " ++
"io:format(\"\\\"~s\\\"~n\","++
- "[[35|[random:uniform(25)+65 || " ++
+ "[[35|[rand:uniform(25)+65 || " ++
"_ <- lists:seq(1, "++
- "random:uniform("++
+ "rand:uniform("++
integer_to_list(MaxLen)++
"))]]]), "++
"F(F,N-1) "++
@@ -189,8 +187,8 @@ receive_all(Iter, ToErl, MaxLen) ->
receive_all_1(0, _, _, _) -> ok;
receive_all_1(Iter, Line, ToErl, MaxLen) ->
- NumChars = random:uniform(MaxLen),
- Pattern = [random:uniform(25)+65 || _ <- lists:seq(1, NumChars)],
+ NumChars = rand:uniform(MaxLen),
+ Pattern = [rand:uniform(25)+65 || _ <- lists:seq(1, NumChars)],
receive_all_2(Iter, {NumChars,Pattern}, Line, ToErl, MaxLen).
diff --git a/erts/vsn.mk b/erts/vsn.mk
index 94b5d0b169..9e4248a668 100644
--- a/erts/vsn.mk
+++ b/erts/vsn.mk
@@ -18,7 +18,7 @@
# %CopyrightEnd%
#
-VSN = 7.2.1
+VSN = 8.0
# Port number 4365 in 4.2
# Port number 4366 in 4.3
diff --git a/lib/Makefile b/lib/Makefile
index 34c2fe9a9e..82c7cb6e18 100644
--- a/lib/Makefile
+++ b/lib/Makefile
@@ -25,8 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
ERTS_APPLICATIONS = stdlib sasl kernel compiler
# Then these have to be build
-ERLANG_APPLICATIONS = tools test_server common_test runtime_tools \
- inets parsetools
+ERLANG_APPLICATIONS = tools common_test runtime_tools inets parsetools
# These are only build if -a is given to otp_build or make is used directly
ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \
@@ -35,8 +34,8 @@ ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \
ic mnesia crypto orber os_mon syntax_tools \
public_key ssl observer odbc diameter \
cosTransactions cosEvent cosTime cosNotification \
- cosProperty cosFileTransfer cosEventDomain et megaco webtool \
- eunit ssh typer percept eldap dialyzer hipe ose
+ cosProperty cosFileTransfer cosEventDomain et megaco \
+ eunit ssh typer percept eldap dialyzer hipe
ifdef BUILD_ALL
ERLANG_APPLICATIONS += $(ALL_ERLANG_APPLICATIONS)
diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile
index 2b72e1a214..e0d4f09a70 100644
--- a/lib/asn1/c_src/Makefile
+++ b/lib/asn1/c_src/Makefile
@@ -97,12 +97,7 @@ endif
_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR))
-ifneq ($(findstring ose,$(TARGET)),ose)
opt: $(NIF_SHARED_OBJ_FILE)
-else
-# Do not build dynamic files on OSE
-opt:
-endif
debug: opt
@@ -140,9 +135,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk
release_spec: opt
$(INSTALL_DIR) "$(RELSYSDIR)/priv/lib"
-ifneq ($(findstring ose,$(TARGET)),ose)
$(INSTALL_PROGRAM) $(NIF_SHARED_OBJ_FILE) "$(RELSYSDIR)/priv/lib"
-endif
$(INSTALL_DIR) "$(RELSYSDIR)/c_src"
$(INSTALL_DATA) *.c "$(RELSYSDIR)/c_src"
diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl
index 7f20d57b1e..61a5661a11 100644
--- a/lib/asn1/src/asn1ct_value.erl
+++ b/lib/asn1/src/asn1ct_value.erl
@@ -353,10 +353,7 @@ random_unnamed_bit_string(M, C) ->
%% end.
random(Upper) ->
- _ = random:seed(erlang:phash2([erlang:node()]),
- erlang:monotonic_time(),
- erlang:unique_integer()),
- random:uniform(Upper).
+ rand:uniform(Upper).
size_random(C) ->
case get_constraint(C,'SizeConstraint') of
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index ce87fd3180..d392055458 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -28,7 +28,7 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%------------------------------------------------------------------------------
%% Suite definition
diff --git a/lib/asn1/test/asn1_SUITE_data/test_records.erl b/lib/asn1/test/asn1_SUITE_data/test_records.erl
index adfc98600c..65716bb0dc 100644
--- a/lib/asn1/test/asn1_SUITE_data/test_records.erl
+++ b/lib/asn1/test/asn1_SUITE_data/test_records.erl
@@ -23,9 +23,6 @@
-export(['check_record_names_OTP-5812'/1]).
-%-include("test_server.hrl").
-%-include_lib("test_server/include/test_server.hrl").
-
-define(line,put(test_server_loc,{?MODULE,?LINE}),).
-include("NBAP-PDU-Discriptions.hrl").
diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl
index ae2e5641ec..dbb2600b41 100644
--- a/lib/asn1/test/asn1_test_lib.erl
+++ b/lib/asn1/test/asn1_test_lib.erl
@@ -26,7 +26,7 @@
parallel/0,
roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
run_dialyzer() ->
false.
diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl
index a3413d1b3d..caae845592 100644
--- a/lib/asn1/test/error_SUITE.erl
+++ b/lib/asn1/test/error_SUITE.erl
@@ -27,7 +27,7 @@
object_sets/1,parameterization/1,
syntax/1,table_constraints/1,tags/1,values/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks, [ts_install_cth]}].
diff --git a/lib/asn1/test/h323test.erl b/lib/asn1/test/h323test.erl
index 39097a9330..566abd9714 100644
--- a/lib/asn1/test/h323test.erl
+++ b/lib/asn1/test/h323test.erl
@@ -21,7 +21,7 @@
-module(h323test).
-export([run/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
run(per) -> run();
run(_Rules) -> ok.
diff --git a/lib/asn1/test/syntax_SUITE.erl b/lib/asn1/test/syntax_SUITE.erl
index 2c23416433..a354b75062 100644
--- a/lib/asn1/test/syntax_SUITE.erl
+++ b/lib/asn1/test/syntax_SUITE.erl
@@ -33,7 +33,7 @@
types/1,
values/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks, [ts_install_cth]}].
diff --git a/lib/asn1/test/testChoExtension.erl b/lib/asn1/test/testChoExtension.erl
index 33515403d1..f4dc00b33c 100644
--- a/lib/asn1/test/testChoExtension.erl
+++ b/lib/asn1/test/testChoExtension.erl
@@ -22,7 +22,7 @@
-export([extension/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
extension(_Rules) ->
diff --git a/lib/asn1/test/testChoExternal.erl b/lib/asn1/test/testChoExternal.erl
index 980b837475..fd9bcf4406 100644
--- a/lib/asn1/test/testChoExternal.erl
+++ b/lib/asn1/test/testChoExternal.erl
@@ -21,7 +21,7 @@
-module(testChoExternal).
-export([external/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("External.hrl").
external(_Rules) ->
diff --git a/lib/asn1/test/testChoPrim.erl b/lib/asn1/test/testChoPrim.erl
index abf3fcdb81..14518285aa 100644
--- a/lib/asn1/test/testChoPrim.erl
+++ b/lib/asn1/test/testChoPrim.erl
@@ -23,7 +23,7 @@
-export([bool/1]).
-export([int/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
bool(Rules) ->
roundtrip('ChoCon', {bool0,true}),
diff --git a/lib/asn1/test/testChoRecursive.erl b/lib/asn1/test/testChoRecursive.erl
index a307d448ed..040aeabe48 100644
--- a/lib/asn1/test/testChoRecursive.erl
+++ b/lib/asn1/test/testChoRecursive.erl
@@ -23,7 +23,7 @@
-export([recursive/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('ChoRec_something',{a, b, c}).
-record('ChoRec2_something',{a, b, c}).
diff --git a/lib/asn1/test/testChoTypeRefCho.erl b/lib/asn1/test/testChoTypeRefCho.erl
index 378a43fa59..b0a9fd68bd 100644
--- a/lib/asn1/test/testChoTypeRefCho.erl
+++ b/lib/asn1/test/testChoTypeRefCho.erl
@@ -22,7 +22,7 @@
-export([choice/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
choice(_Rules) ->
roundtrip('ChoTRcho', {choCho,{choInt,88}}),
diff --git a/lib/asn1/test/testChoTypeRefPrim.erl b/lib/asn1/test/testChoTypeRefPrim.erl
index 3541277674..59d23a8683 100644
--- a/lib/asn1/test/testChoTypeRefPrim.erl
+++ b/lib/asn1/test/testChoTypeRefPrim.erl
@@ -22,7 +22,7 @@
-export([prim/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
prim(_Rules) ->
roundtrip('ChoTR', {bool,true}),
diff --git a/lib/asn1/test/testChoTypeRefSeq.erl b/lib/asn1/test/testChoTypeRefSeq.erl
index c582d6f0fc..87c94fc888 100644
--- a/lib/asn1/test/testChoTypeRefSeq.erl
+++ b/lib/asn1/test/testChoTypeRefSeq.erl
@@ -22,7 +22,7 @@
-export([seq/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('ChoSeq', {seqInt, seqOs}).
-record('ChoSeqImp', {seqInt, seqOs}).
diff --git a/lib/asn1/test/testChoTypeRefSet.erl b/lib/asn1/test/testChoTypeRefSet.erl
index 2d4f6cce4b..d2ff48af91 100644
--- a/lib/asn1/test/testChoTypeRefSet.erl
+++ b/lib/asn1/test/testChoTypeRefSet.erl
@@ -22,7 +22,7 @@
-export([set/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('ChoSet', {setInt, setOs}).
-record('ChoSetImp', {setInt, setOs}).
diff --git a/lib/asn1/test/testChoiceIndefinite.erl b/lib/asn1/test/testChoiceIndefinite.erl
index d796871620..f5ae3ff882 100644
--- a/lib/asn1/test/testChoiceIndefinite.erl
+++ b/lib/asn1/test/testChoiceIndefinite.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
main(per) -> ok;
main(ber) ->
diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl
index 60b7994929..7da3ea3d38 100644
--- a/lib/asn1/test/testConstraints.erl
+++ b/lib/asn1/test/testConstraints.erl
@@ -23,7 +23,7 @@
-export([int_constraints/1,refed_NNL_name/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
int_constraints(Rules) ->
diff --git a/lib/asn1/test/testContextSwitchingTypes.erl b/lib/asn1/test/testContextSwitchingTypes.erl
index f1af6cf0e5..3779f61f2f 100644
--- a/lib/asn1/test/testContextSwitchingTypes.erl
+++ b/lib/asn1/test/testContextSwitchingTypes.erl
@@ -22,7 +22,7 @@
-export([test/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
test(Config) ->
ValT_1 = 'ContextSwitchingTypes':'val1-T'(),
diff --git a/lib/asn1/test/testDER.erl b/lib/asn1/test/testDER.erl
index 195d8fe5a4..edaaa12eba 100644
--- a/lib/asn1/test/testDER.erl
+++ b/lib/asn1/test/testDER.erl
@@ -22,7 +22,7 @@
-export([test/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
test() ->
Val = {'Set',12,{version,214},true},
diff --git a/lib/asn1/test/testDeepTConstr.erl b/lib/asn1/test/testDeepTConstr.erl
index 50291bf645..ed37df7204 100644
--- a/lib/asn1/test/testDeepTConstr.erl
+++ b/lib/asn1/test/testDeepTConstr.erl
@@ -24,7 +24,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
main(_Erule) ->
Val1 = {substrings,
diff --git a/lib/asn1/test/testDef.erl b/lib/asn1/test/testDef.erl
index c07665d097..5fa5711473 100644
--- a/lib/asn1/test/testDef.erl
+++ b/lib/asn1/test/testDef.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('Def1',{bool0,
bool1 = asn1_DEFAULT,
diff --git a/lib/asn1/test/testDoubleEllipses.erl b/lib/asn1/test/testDoubleEllipses.erl
index 8dcd979d6a..4a054a14ed 100644
--- a/lib/asn1/test/testDoubleEllipses.erl
+++ b/lib/asn1/test/testDoubleEllipses.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('Seq',{a, c}).
-record('SeqV1',{a, b}).
diff --git a/lib/asn1/test/testEnumExt.erl b/lib/asn1/test/testEnumExt.erl
index 122d198205..057fcb694b 100644
--- a/lib/asn1/test/testEnumExt.erl
+++ b/lib/asn1/test/testEnumExt.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
main(Rule) when Rule =:= per; Rule =:= uper ->
io:format("main(~p)~n",[Rule]),
diff --git a/lib/asn1/test/testINSTANCE_OF.erl b/lib/asn1/test/testINSTANCE_OF.erl
index afff05a4c5..b9079d8e95 100644
--- a/lib/asn1/test/testINSTANCE_OF.erl
+++ b/lib/asn1/test/testINSTANCE_OF.erl
@@ -21,7 +21,7 @@
-module(testINSTANCE_OF).
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
main(_Erule) ->
Int = roundtrip('Int', 3),
diff --git a/lib/asn1/test/testInfObjectClass.erl b/lib/asn1/test/testInfObjectClass.erl
index 271be63fc8..a7d0f2b6bd 100644
--- a/lib/asn1/test/testInfObjectClass.erl
+++ b/lib/asn1/test/testInfObjectClass.erl
@@ -24,7 +24,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
main(Rule) ->
%% this test is added for OTP-4591, to test that elements in decoded
diff --git a/lib/asn1/test/testMegaco.erl b/lib/asn1/test/testMegaco.erl
index b1b1c866be..61794ec02d 100644
--- a/lib/asn1/test/testMegaco.erl
+++ b/lib/asn1/test/testMegaco.erl
@@ -23,7 +23,7 @@
-export([compile/3,main/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
compile(Config, Erule, Options) ->
asn1_test_lib:compile("MEDIA-GATEWAY-CONTROL.asn", Config, [Erule|Options]),
diff --git a/lib/asn1/test/testMergeCompile.erl b/lib/asn1/test/testMergeCompile.erl
index 6bf7aaa1d6..5011c7d576 100644
--- a/lib/asn1/test/testMergeCompile.erl
+++ b/lib/asn1/test/testMergeCompile.erl
@@ -23,7 +23,7 @@
-export([main/1,mvrasn/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('InitiatingMessage',{procedureCode,criticality,value}).
-record('Iu-ReleaseCommand',{protocolIEs,protocolExtensions}).
diff --git a/lib/asn1/test/testNBAPsystem.erl b/lib/asn1/test/testNBAPsystem.erl
index e0eeb9fe0c..2a7e39597a 100644
--- a/lib/asn1/test/testNBAPsystem.erl
+++ b/lib/asn1/test/testNBAPsystem.erl
@@ -22,7 +22,7 @@
-export([compile/2,test/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('InitiatingMessage',{
procedureID, criticality, messageDiscriminator, transactionID, value}).
diff --git a/lib/asn1/test/testOpenTypeImplicitTag.erl b/lib/asn1/test/testOpenTypeImplicitTag.erl
index 01e0a5e07f..fc2f2a81e6 100644
--- a/lib/asn1/test/testOpenTypeImplicitTag.erl
+++ b/lib/asn1/test/testOpenTypeImplicitTag.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
main(_Rules) ->
roundtrip('Seq', {'Seq',<<1,1,255>>,<<1,1,255>>,12,<<1,1,255>>}),
diff --git a/lib/asn1/test/testOpt.erl b/lib/asn1/test/testOpt.erl
index 1f96331966..a15aa28f02 100644
--- a/lib/asn1/test/testOpt.erl
+++ b/lib/asn1/test/testOpt.erl
@@ -21,7 +21,7 @@
-module(testOpt).
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('Opt1',{bool0,
bool1 = asn1_NOVALUE,
diff --git a/lib/asn1/test/testParamBasic.erl b/lib/asn1/test/testParamBasic.erl
index f4a696ff38..768c5ad2fa 100644
--- a/lib/asn1/test/testParamBasic.erl
+++ b/lib/asn1/test/testParamBasic.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('T11',{number, string=asn1_DEFAULT}).
-record('T12',{number, string=asn1_DEFAULT}).
diff --git a/lib/asn1/test/testParameterizedInfObj.erl b/lib/asn1/test/testParameterizedInfObj.erl
index 592dc693f0..8b0353522d 100644
--- a/lib/asn1/test/testParameterizedInfObj.erl
+++ b/lib/asn1/test/testParameterizedInfObj.erl
@@ -23,7 +23,7 @@
-export([main/2,param/1,ranap/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('AllocationOrRetentionPriority',{priorityLevel,iE_Extensions}).
-record('ProtocolExtensionField',{id,criticality,extensionValue}).
diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl
index dc2e0fa2e7..82da953ca1 100644
--- a/lib/asn1/test/testPrim.erl
+++ b/lib/asn1/test/testPrim.erl
@@ -28,7 +28,7 @@
-export([null/1]).
-export([real/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
bool(Rules) ->
Types = ['Bool','BoolCon','BoolPri','BoolApp',
diff --git a/lib/asn1/test/testPrimExternal.erl b/lib/asn1/test/testPrimExternal.erl
index 56252241d4..79c8a3a045 100644
--- a/lib/asn1/test/testPrimExternal.erl
+++ b/lib/asn1/test/testPrimExternal.erl
@@ -22,7 +22,7 @@
-export([external/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
external(_Rules) ->
Types = ['NT',
diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl
index 46793c6bff..042b1757ba 100644
--- a/lib/asn1/test/testPrimStrings.erl
+++ b/lib/asn1/test/testPrimStrings.erl
@@ -33,7 +33,7 @@
-export([utf8_string/1]).
-export([fragmented/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
fragmented(Rules) ->
Lens = fragmented_lengths(),
@@ -54,7 +54,7 @@ fragmented_strings(Len, Types) ->
ok.
make_ns_value(0) -> [];
-make_ns_value(N) -> [($0 - 1) + random:uniform(10)|make_ns_value(N-1)].
+make_ns_value(N) -> [($0 - 1) + rand:uniform(10)|make_ns_value(N-1)].
fragmented_lengths() ->
K16 = 1 bsl 14,
diff --git a/lib/asn1/test/testRfcs.erl b/lib/asn1/test/testRfcs.erl
index 20eaee9982..fa4389b904 100644
--- a/lib/asn1/test/testRfcs.erl
+++ b/lib/asn1/test/testRfcs.erl
@@ -23,7 +23,7 @@
-export([compile/3,test/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
compile(Config, Erules, Options0) ->
Options = [no_ok_wrapper|Options0],
diff --git a/lib/asn1/test/testSSLspecs.erl b/lib/asn1/test/testSSLspecs.erl
index 9e51021ad2..7dc7eedd50 100644
--- a/lib/asn1/test/testSSLspecs.erl
+++ b/lib/asn1/test/testSSLspecs.erl
@@ -23,7 +23,7 @@
-export([compile/2,run/1,compile_combined/2,run_combined/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
compile(Config, Options) ->
DataDir = ?config(data_dir, Config),
diff --git a/lib/asn1/test/testSelectionTypes.erl b/lib/asn1/test/testSelectionTypes.erl
index d33cfcc694..7039f6da4e 100644
--- a/lib/asn1/test/testSelectionTypes.erl
+++ b/lib/asn1/test/testSelectionTypes.erl
@@ -21,7 +21,7 @@
-module(testSelectionTypes).
-export([test/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
test() ->
["Es"] = Val2 = ['SelectionType':einsteinium()],
diff --git a/lib/asn1/test/testSeq2738.erl b/lib/asn1/test/testSeq2738.erl
index 3c9e4a744e..a75d058259 100644
--- a/lib/asn1/test/testSeq2738.erl
+++ b/lib/asn1/test/testSeq2738.erl
@@ -21,7 +21,7 @@
-module(testSeq2738).
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SeqOptFake',{int, opt = asn1_NOVALUE}).
-record('OptSeqFake',{bool = false}).
diff --git a/lib/asn1/test/testSeqDefault.erl b/lib/asn1/test/testSeqDefault.erl
index db0914bf0a..ac3cf202b7 100644
--- a/lib/asn1/test/testSeqDefault.erl
+++ b/lib/asn1/test/testSeqDefault.erl
@@ -23,7 +23,7 @@
-include("External.hrl").
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SeqDef1',{bool1 = asn1_DEFAULT, int1, seq1 = asn1_DEFAULT}).
-record('SeqDef1Imp',{bool1 = asn1_DEFAULT, int1, seq1 = asn1_DEFAULT}).
diff --git a/lib/asn1/test/testSeqExtension.erl b/lib/asn1/test/testSeqExtension.erl
index 6b49b29047..a84b6fb27c 100644
--- a/lib/asn1/test/testSeqExtension.erl
+++ b/lib/asn1/test/testSeqExtension.erl
@@ -23,7 +23,7 @@
-include("External.hrl").
-export([main/3]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SeqExt1',{}).
-record('SeqExt2',{bool, int}).
diff --git a/lib/asn1/test/testSeqExternal.erl b/lib/asn1/test/testSeqExternal.erl
index a48794924f..9ad2c03208 100644
--- a/lib/asn1/test/testSeqExternal.erl
+++ b/lib/asn1/test/testSeqExternal.erl
@@ -23,7 +23,7 @@
-include("External.hrl").
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SeqXSet1',{set, bool, int}).
-record('SeqXSet2',{bool, set, int}).
diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl
index 898b8c1e15..f4a4181f51 100644
--- a/lib/asn1/test/testSeqOf.erl
+++ b/lib/asn1/test/testSeqOf.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('Seq1',{bool1, int1, seq1 = asn1_DEFAULT}).
-record('Seq2',{seq2 = asn1_DEFAULT, bool2, int2}).
diff --git a/lib/asn1/test/testSeqOfCho.erl b/lib/asn1/test/testSeqOfCho.erl
index 82ac56ac50..7bd1ce7aa6 100644
--- a/lib/asn1/test/testSeqOfCho.erl
+++ b/lib/asn1/test/testSeqOfCho.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SeqChoDef',{bool1, int1, seq1 = asn1_DEFAULT}).
-record('SeqChoOpt',{bool1, int1, seq1 = asn1_NOVALUE}).
diff --git a/lib/asn1/test/testSeqOfExternal.erl b/lib/asn1/test/testSeqOfExternal.erl
index 560fdecb64..de95e081d5 100644
--- a/lib/asn1/test/testSeqOfExternal.erl
+++ b/lib/asn1/test/testSeqOfExternal.erl
@@ -21,7 +21,7 @@
-module(testSeqOfExternal).
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("External.hrl").
-record('NT',{os, bool}).
diff --git a/lib/asn1/test/testSeqOfIndefinite.erl b/lib/asn1/test/testSeqOfIndefinite.erl
index 4a0101834a..bebd516c5c 100644
--- a/lib/asn1/test/testSeqOfIndefinite.erl
+++ b/lib/asn1/test/testSeqOfIndefinite.erl
@@ -22,7 +22,7 @@
-export([main/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
main() ->
?line ok = test(isd),
diff --git a/lib/asn1/test/testSeqOfTag.erl b/lib/asn1/test/testSeqOfTag.erl
index 55f807199f..cacbc85093 100644
--- a/lib/asn1/test/testSeqOfTag.erl
+++ b/lib/asn1/test/testSeqOfTag.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("External.hrl").
diff --git a/lib/asn1/test/testSeqOptional.erl b/lib/asn1/test/testSeqOptional.erl
index db615d6e4d..92b49e9c0d 100644
--- a/lib/asn1/test/testSeqOptional.erl
+++ b/lib/asn1/test/testSeqOptional.erl
@@ -23,7 +23,7 @@
-include("External.hrl").
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SeqOpt1',{bool1 = asn1_NOVALUE, int1, seq1 = asn1_NOVALUE}).
-record('SeqOpt1Imp',{bool1 = asn1_NOVALUE, int1, seq1 = asn1_NOVALUE}).
diff --git a/lib/asn1/test/testSeqPrim.erl b/lib/asn1/test/testSeqPrim.erl
index 6af0ce9287..5872902ce7 100644
--- a/lib/asn1/test/testSeqPrim.erl
+++ b/lib/asn1/test/testSeqPrim.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('Seq',{bool, boolCon, boolPri, boolApp, boolExpCon, boolExpPri, boolExpApp}).
-record('Empty',{}).
diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl
index 86ab07a4a8..1c41f64078 100644
--- a/lib/asn1/test/testSeqSetDefaultVal.erl
+++ b/lib/asn1/test/testSeqSetDefaultVal.erl
@@ -22,7 +22,7 @@
-export([main/2]).
-include("External.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SeqInts',{a = asn1_DEFAULT,
b = asn1_DEFAULT,
diff --git a/lib/asn1/test/testSeqSetIndefinite.erl b/lib/asn1/test/testSeqSetIndefinite.erl
index 8948e10ece..41e09f7796 100644
--- a/lib/asn1/test/testSeqSetIndefinite.erl
+++ b/lib/asn1/test/testSeqSetIndefinite.erl
@@ -21,7 +21,7 @@
-module(testSeqSetIndefinite).
-export([main/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
main() ->
seq_indefinite(),
diff --git a/lib/asn1/test/testSeqTag.erl b/lib/asn1/test/testSeqTag.erl
index baa79ed428..6959e2f7e2 100644
--- a/lib/asn1/test/testSeqTag.erl
+++ b/lib/asn1/test/testSeqTag.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("External.hrl").
-record('SeqTag',{nt, imp, exp}).
diff --git a/lib/asn1/test/testSeqTypeRefCho.erl b/lib/asn1/test/testSeqTypeRefCho.erl
index 372be0c637..4a9ba53291 100644
--- a/lib/asn1/test/testSeqTypeRefCho.erl
+++ b/lib/asn1/test/testSeqTypeRefCho.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("External.hrl").
-record('SeqTRcho',{seqCho, seqChoE, 'seqCho-E', 'seqChoE-E'}).
diff --git a/lib/asn1/test/testSeqTypeRefPrim.erl b/lib/asn1/test/testSeqTypeRefPrim.erl
index 42554e758e..e0c3277156 100644
--- a/lib/asn1/test/testSeqTypeRefPrim.erl
+++ b/lib/asn1/test/testSeqTypeRefPrim.erl
@@ -21,7 +21,7 @@
-module(testSeqTypeRefPrim).
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SeqTR',{octStr, octStrI, octStrE, 'octStr-I', 'octStrI-I', 'octStrE-I', 'octStr-E', 'octStrI-E', 'octStrE-E'}).
diff --git a/lib/asn1/test/testSeqTypeRefSeq.erl b/lib/asn1/test/testSeqTypeRefSeq.erl
index ee30937af5..befbe5f457 100644
--- a/lib/asn1/test/testSeqTypeRefSeq.erl
+++ b/lib/asn1/test/testSeqTypeRefSeq.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('Seq1',{bool1, int1, seq1}).
-record('Seq2',{seq2, bool2, int2}).
diff --git a/lib/asn1/test/testSeqTypeRefSet.erl b/lib/asn1/test/testSeqTypeRefSet.erl
index ba690b4503..48c94a8b06 100644
--- a/lib/asn1/test/testSeqTypeRefSet.erl
+++ b/lib/asn1/test/testSeqTypeRefSet.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SeqTRset',{seqSet, seqSetI, seqSetE, 'seqSet-I', 'seqSetI-I', 'seqSetE-I', 'seqSet-E', 'seqSetI-E', 'seqSetE-E'}).
-record('SeqSet',{setInt, setOs}).
diff --git a/lib/asn1/test/testSetDefault.erl b/lib/asn1/test/testSetDefault.erl
index 4e34c01a52..e91a526add 100644
--- a/lib/asn1/test/testSetDefault.erl
+++ b/lib/asn1/test/testSetDefault.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SetDef1',{bool1 = asn1_DEFAULT, int1, set1 = asn1_DEFAULT}).
-record('SetDef2',{set2 = asn1_DEFAULT, bool2, int2}).
diff --git a/lib/asn1/test/testSetExtension.erl b/lib/asn1/test/testSetExtension.erl
index 67977a2a31..89f27a7fef 100644
--- a/lib/asn1/test/testSetExtension.erl
+++ b/lib/asn1/test/testSetExtension.erl
@@ -22,7 +22,7 @@
-include("External.hrl").
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SetExt1',{}).
-record('SetExt2',{bool, int}).
diff --git a/lib/asn1/test/testSetExternal.erl b/lib/asn1/test/testSetExternal.erl
index e265cf1f3e..f5d01e23a8 100644
--- a/lib/asn1/test/testSetExternal.erl
+++ b/lib/asn1/test/testSetExternal.erl
@@ -22,7 +22,7 @@
-export([main/1]).
-include("External.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SetXSeq1',{seq, bool, int}).
-record('SetXSeq2',{bool, seq, int}).
diff --git a/lib/asn1/test/testSetOf.erl b/lib/asn1/test/testSetOf.erl
index 4ff90676aa..02009dc8d5 100644
--- a/lib/asn1/test/testSetOf.erl
+++ b/lib/asn1/test/testSetOf.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('Set1',{bool1, int1, set1 = asn1_DEFAULT}).
-record('Set2',{set2 = asn1_DEFAULT, bool2, int2}).
diff --git a/lib/asn1/test/testSetOfCho.erl b/lib/asn1/test/testSetOfCho.erl
index 002fa9be0a..be199b4688 100644
--- a/lib/asn1/test/testSetOfCho.erl
+++ b/lib/asn1/test/testSetOfCho.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SetChoDef',{bool1, int1, set1 = asn1_DEFAULT}).
-record('SetChoOpt',{bool1, int1, set1 = asn1_NOVALUE}).
diff --git a/lib/asn1/test/testSetOfExternal.erl b/lib/asn1/test/testSetOfExternal.erl
index 60bde33962..7abed66167 100644
--- a/lib/asn1/test/testSetOfExternal.erl
+++ b/lib/asn1/test/testSetOfExternal.erl
@@ -21,7 +21,7 @@
-module(testSetOfExternal).
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("External.hrl").
-record('NT',{os, bool}).
diff --git a/lib/asn1/test/testSetOfTag.erl b/lib/asn1/test/testSetOfTag.erl
index 96dc9942d7..ce77e2848f 100644
--- a/lib/asn1/test/testSetOfTag.erl
+++ b/lib/asn1/test/testSetOfTag.erl
@@ -21,7 +21,7 @@
-module(testSetOfTag).
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("External.hrl").
-record('SetTagNt',{nt}).
diff --git a/lib/asn1/test/testSetPrim.erl b/lib/asn1/test/testSetPrim.erl
index a4b8bb2f09..47913178f3 100644
--- a/lib/asn1/test/testSetPrim.erl
+++ b/lib/asn1/test/testSetPrim.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('Set',{bool, boolCon, boolPri, boolApp, boolExpCon, boolExpPri, boolExpApp}).
-record('Empty',{}).
diff --git a/lib/asn1/test/testSetTag.erl b/lib/asn1/test/testSetTag.erl
index b963ecb4b3..2e95fb6793 100644
--- a/lib/asn1/test/testSetTag.erl
+++ b/lib/asn1/test/testSetTag.erl
@@ -21,7 +21,7 @@
-module(testSetTag).
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("External.hrl").
-record('SetTag',{nt, imp, exp}).
diff --git a/lib/asn1/test/testSetTypeRefCho.erl b/lib/asn1/test/testSetTypeRefCho.erl
index adffb646fb..ac5bf5ab02 100644
--- a/lib/asn1/test/testSetTypeRefCho.erl
+++ b/lib/asn1/test/testSetTypeRefCho.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("External.hrl").
-record('SetTRcho',{setCho, setChoE, 'setCho-E', 'setChoE-E'}).
diff --git a/lib/asn1/test/testSetTypeRefPrim.erl b/lib/asn1/test/testSetTypeRefPrim.erl
index e20b6c57ab..51190e2ba4 100644
--- a/lib/asn1/test/testSetTypeRefPrim.erl
+++ b/lib/asn1/test/testSetTypeRefPrim.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SetTR',{octStr, octStrI, octStrE, 'octStr-I', 'octStrI-I', 'octStrE-I', 'octStr-E', 'octStrI-E', 'octStrE-E'}).
diff --git a/lib/asn1/test/testSetTypeRefSeq.erl b/lib/asn1/test/testSetTypeRefSeq.erl
index 0d2bd6b32d..44a7910526 100644
--- a/lib/asn1/test/testSetTypeRefSeq.erl
+++ b/lib/asn1/test/testSetTypeRefSeq.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('SetTRseq',{setSeq, setSeqI, setSeqE, 'setSeq-I', 'setSeqI-I', 'setSeqE-I', 'setSeq-E', 'setSeqI-E', 'setSeqE-E'}).
-record('SetSeq',{seqInt, seqOs}).
diff --git a/lib/asn1/test/testSetTypeRefSet.erl b/lib/asn1/test/testSetTypeRefSet.erl
index 85d9bf52cd..7a67e6434c 100644
--- a/lib/asn1/test/testSetTypeRefSet.erl
+++ b/lib/asn1/test/testSetTypeRefSet.erl
@@ -22,7 +22,7 @@
-export([main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record('Set1',{bool1, int1, set1}).
-record('Set2',{set2, bool2, int2}).
diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl
index 6c66d73feb..6e777875f6 100644
--- a/lib/asn1/test/testTCAP.erl
+++ b/lib/asn1/test/testTCAP.erl
@@ -22,7 +22,7 @@
-export([compile/2,test/2,compile_asn1config/2,test_asn1config/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
compile(Config, Options) ->
Files = ["Remote-Operations-Information-Objects",
diff --git a/lib/asn1/test/testTimer.erl b/lib/asn1/test/testTimer.erl
index 30e31796e2..6fecee3d78 100644
--- a/lib/asn1/test/testTimer.erl
+++ b/lib/asn1/test/testTimer.erl
@@ -21,7 +21,7 @@
-module(testTimer).
-export([go/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(times, 5000).
diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl
index 8be3a29763..1af614f49a 100644
--- a/lib/asn1/test/test_compile_options.erl
+++ b/lib/asn1/test/test_compile_options.erl
@@ -21,7 +21,7 @@
-module(test_compile_options).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([wrong_path/1,comp/2,path/1,ticket_6143/1,noobj/1,
diff --git a/lib/asn1/test/test_modified_x420.erl b/lib/asn1/test/test_modified_x420.erl
index f9a29d1436..c0a32e2a37 100644
--- a/lib/asn1/test/test_modified_x420.erl
+++ b/lib/asn1/test/test_modified_x420.erl
@@ -21,7 +21,7 @@
-module(test_modified_x420).
-export([test/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
test(Config) ->
DataDir = ?config(data_dir,Config),
diff --git a/lib/asn1/test/test_partial_incomplete_decode.erl b/lib/asn1/test/test_partial_incomplete_decode.erl
index d5eacc5a4d..64f2ce22ae 100644
--- a/lib/asn1/test/test_partial_incomplete_decode.erl
+++ b/lib/asn1/test/test_partial_incomplete_decode.erl
@@ -22,7 +22,7 @@
-export([test/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
test(Config) ->
FMsg = msg('F'),
diff --git a/lib/asn1/test/test_selective_decode.erl b/lib/asn1/test/test_selective_decode.erl
index 079351db19..d7870057a8 100644
--- a/lib/asn1/test/test_selective_decode.erl
+++ b/lib/asn1/test/test_selective_decode.erl
@@ -21,7 +21,7 @@
-module(test_selective_decode).
-export([test/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
test() ->
FMsg = msg('F'),
diff --git a/lib/asn1/test/test_special_decode_performance.erl b/lib/asn1/test/test_special_decode_performance.erl
index 7bb324c902..6cf7ee2805 100644
--- a/lib/asn1/test/test_special_decode_performance.erl
+++ b/lib/asn1/test/test_special_decode_performance.erl
@@ -22,7 +22,7 @@
-export([go/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
go(all) ->
{Time_S_s,Time_S_e,Time_S_c}=go(10000,'PartialDecSeq'),
diff --git a/lib/asn1/test/test_undecoded_rest.erl b/lib/asn1/test/test_undecoded_rest.erl
index 6264530fff..77147d59cc 100644
--- a/lib/asn1/test/test_undecoded_rest.erl
+++ b/lib/asn1/test/test_undecoded_rest.erl
@@ -22,7 +22,7 @@
-export([test/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% testing OTP-5104
diff --git a/lib/asn1/test/test_x691.erl b/lib/asn1/test/test_x691.erl
index 56c1b9bf71..8ef62960ff 100644
--- a/lib/asn1/test/test_x691.erl
+++ b/lib/asn1/test/test_x691.erl
@@ -21,7 +21,7 @@
-module(test_x691).
-export([cases/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
cases(Erule) ->
_ = [begin
diff --git a/lib/common_test/include/ct.hrl b/lib/common_test/include/ct.hrl
index 53bc43fc24..5806f75806 100644
--- a/lib/common_test/include/ct.hrl
+++ b/lib/common_test/include/ct.hrl
@@ -18,8 +18,6 @@
%% %CopyrightEnd%
%%
--include_lib("test_server/include/test_server.hrl").
-
%% the log level is used as argument to any CT logging function
-define(MIN_IMPORTANCE, 0 ).
-define(LOW_IMPORTANCE, 25).
@@ -37,3 +35,9 @@
%% name of process executing the CT Hook init and terminate function
-define(CT_HOOK_INIT_PROCESS, ct_util_server).
-define(CT_HOOK_TERMINATE_PROCESS, ct_util_server).
+
+%% Backward compatibility for test_server test suites.
+%% DO NOT USE IN NEW TEST SUITES.
+-define(line,).
+-define(t,test_server).
+-define(config,test_server:lookup_config).
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile
index 987345c679..91c1e8ede8 100644
--- a/lib/common_test/src/Makefile
+++ b/lib/common_test/src/Makefile
@@ -79,7 +79,15 @@ MODULES= \
cth_conn_log \
ct_groups \
ct_property_test \
- ct_release_test
+ ct_release_test \
+ erl2html2 \
+ test_server_ctrl \
+ test_server_gl \
+ test_server_io \
+ test_server_node \
+ test_server \
+ test_server_sup
+
TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
@@ -101,8 +109,7 @@ DTD_FILES = \
# FLAGS
# ----------------------------------------------------
ERL_COMPILE_FLAGS += -pa ../ebin -I../include -I $(ERL_TOP)/lib/snmp/include/ \
- -I../../test_server/include -I../../xmerl/inc/ \
- -I $(ERL_TOP)/lib/kernel/include -Werror
+ -I../../xmerl/inc/ -I $(ERL_TOP)/lib/kernel/include -Werror
# ----------------------------------------------------
# Targets
diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl
index 251204aa75..33efe7a14a 100644
--- a/lib/common_test/src/ct_config.erl
+++ b/lib/common_test/src/ct_config.erl
@@ -694,11 +694,10 @@ make_crypto_key(String) ->
{[K1,K2,K3],IVec}.
random_bytes(N) ->
- random:seed(os:timestamp()),
random_bytes_1(N, []).
random_bytes_1(0, Acc) -> Acc;
-random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]).
+random_bytes_1(N, Acc) -> random_bytes_1(N-1, [rand:uniform(255)|Acc]).
check_callback_load(Callback) ->
case code:is_loaded(Callback) of
diff --git a/lib/common_test/src/ct_make.erl b/lib/common_test/src/ct_make.erl
index f4b81a0ef6..e7a9cfa843 100644
--- a/lib/common_test/src/ct_make.erl
+++ b/lib/common_test/src/ct_make.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2013. All Rights Reserved.
+%% 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.
@@ -324,10 +324,11 @@ check_includes(File, IncludePath, ObjMTime) ->
end.
check_includes2(Epp, File, ObjMTime) ->
+ A1 = erl_anno:new(1),
case epp:parse_erl_form(Epp) of
- {ok, {attribute, 1, file, {File, 1}}} ->
+ {ok, {attribute, A1, file, {File, A1}}} ->
check_includes2(Epp, File, ObjMTime);
- {ok, {attribute, 1, file, {IncFile, 1}}} ->
+ {ok, {attribute, A1, file, {IncFile, A1}}} ->
case file:read_file_info(IncFile) of
{ok, #file_info{mtime=MTime}} when MTime>ObjMTime ->
epp:close(Epp),
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index b4364b87ff..39b2c2a8cd 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -2627,11 +2627,9 @@ run_make(Targets, TestDir0, Mod, UserInclude) ->
data=TestDir}),
{ok,Cwd} = file:get_cwd(),
ok = file:set_cwd(TestDir),
- TestServerInclude = get_dir(test_server, "include"),
CtInclude = get_dir(common_test, "include"),
XmerlInclude = get_dir(xmerl, "include"),
- ErlFlags = UserInclude ++ [{i,TestServerInclude},
- {i,CtInclude},
+ ErlFlags = UserInclude ++ [{i,CtInclude},
{i,XmerlInclude},
debug_info],
Result =
diff --git a/lib/test_server/src/erl2html2.erl b/lib/common_test/src/erl2html2.erl
index 2c63103264..e281c9de1b 100644
--- a/lib/test_server/src/erl2html2.erl
+++ b/lib/common_test/src/erl2html2.erl
@@ -170,23 +170,32 @@ get_line(Anno) ->
%%%-----------------------------------------------------------------
%%% Find the line number of the last expression in the function
find_clause_lines([{clause,CL,_Params,_Op,Exprs}], CLs) -> % last clause
- try tuple_to_list(lists:last(Exprs)) of
- [_Type,ExprLine | _] when is_integer(ExprLine) ->
- {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)};
- [tree,_ | Exprs1] ->
+ case classify_exprs(Exprs) of
+ {anno, Anno} ->
+ {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(Anno)};
+ {tree, Exprs1} ->
find_clause_lines([{clause,CL,undefined,undefined,Exprs1}], CLs);
- [macro,{_var,ExprLine,_MACRO} | _] when is_integer(ExprLine) ->
- {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)};
- _ ->
- {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)}
- catch
- _:_ ->
+ unknown ->
{lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)}
end;
-
find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) ->
find_clause_lines(Cs, [{clause,get_line(CL)}|CLs]).
+classify_exprs(Exprs) ->
+ case tuple_to_list(lists:last(Exprs)) of
+ [macro,{_var,Anno,_MACRO} | _] ->
+ {anno, Anno};
+ [T,ExprAnno | Exprs1] ->
+ case erl_anno:is_anno(ExprAnno) of
+ true ->
+ {anno, ExprAnno};
+ false when T =:= tree ->
+ {tree, Exprs1};
+ false ->
+ unknown
+ end
+ end.
+
%%%-----------------------------------------------------------------
%%% Add a link target for each line and one for each function definition.
build_html(SFd,DFd,Encoding,FuncsAndCs) ->
diff --git a/lib/test_server/src/test_server.app.src b/lib/common_test/src/test_server.app.src
index 334be8109d..334be8109d 100644
--- a/lib/test_server/src/test_server.app.src
+++ b/lib/common_test/src/test_server.app.src
diff --git a/lib/test_server/src/test_server.appup.src b/lib/common_test/src/test_server.appup.src
index 7c4aa630ae..7c4aa630ae 100644
--- a/lib/test_server/src/test_server.appup.src
+++ b/lib/common_test/src/test_server.appup.src
diff --git a/lib/test_server/src/test_server.erl b/lib/common_test/src/test_server.erl
index 73803030a3..73803030a3 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/common_test/src/test_server.erl
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl
index 8a46996bc3..cd08a25bd8 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/common_test/src/test_server_ctrl.erl
@@ -3163,11 +3163,17 @@ delete_prop([], Props) ->
%% Shuffles the order of Cases.
shuffle_cases(Ref, Cases, undefined) ->
- shuffle_cases(Ref, Cases, ?now);
+ shuffle_cases(Ref, Cases, rand:seed_s(exsplus));
-shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed) ->
+shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed0) ->
{N,CasesToShuffle,Rest} = cases_to_shuffle(Ref, Cases),
- ShuffledCases = random_order(N, random:uniform_s(N, Seed), CasesToShuffle, []),
+ Seed = case Seed0 of
+ {X,Y,Z} when is_integer(X+Y+Z) ->
+ rand:seed(exsplus, Seed0);
+ _ ->
+ Seed0
+ end,
+ ShuffledCases = random_order(N, rand:uniform_s(N, Seed), CasesToShuffle, []),
[Start|ShuffledCases] ++ Rest.
cases_to_shuffle(Ref, Cases) ->
@@ -3201,7 +3207,7 @@ random_order(1, {_Pos,Seed}, [{_Ix,CaseOrGroup}], Shuffled) ->
Shuffled++CaseOrGroup;
random_order(N, {Pos,NewSeed}, IxCases, Shuffled) ->
{First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases),
- random_order(N-1, random:uniform_s(N-1, NewSeed),
+ random_order(N-1, rand:uniform_s(N-1, NewSeed),
First++Rest, Shuffled++CaseOrGroup).
diff --git a/lib/test_server/src/test_server_gl.erl b/lib/common_test/src/test_server_gl.erl
index c5ec3ccbe6..31098d9726 100644
--- a/lib/test_server/src/test_server_gl.erl
+++ b/lib/common_test/src/test_server_gl.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2012-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.
@@ -30,7 +30,7 @@
-export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]).
-record(st, {tc_supervisor :: 'none'|pid(), %Test case supervisor
- tc :: mfa(), %Current test case MFA
+ tc :: mfa() | 'undefined', %Current test case MFA
minor :: 'none'|pid(), %Minor fd
minor_monitor, %Monitor ref for minor fd
capture :: 'none'|pid(), %Capture output
diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/common_test/src/test_server_internal.hrl
index 578f359010..578f359010 100644
--- a/lib/test_server/src/test_server_internal.hrl
+++ b/lib/common_test/src/test_server_internal.hrl
diff --git a/lib/test_server/src/test_server_io.erl b/lib/common_test/src/test_server_io.erl
index 0d881d0ada..0d881d0ada 100644
--- a/lib/test_server/src/test_server_io.erl
+++ b/lib/common_test/src/test_server_io.erl
diff --git a/lib/test_server/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl
index 70cc2625d4..c12832e0d0 100644
--- a/lib/test_server/src/test_server_node.erl
+++ b/lib/common_test/src/test_server_node.erl
@@ -628,8 +628,7 @@ do_quote_progname([Prog,Arg|Args]) ->
end.
random_element(L) ->
- random:seed(os:timestamp()),
- lists:nth(random:uniform(length(L)), L).
+ lists:nth(rand:uniform(length(L)), L).
find_release(latest) ->
"/usr/local/otp/releases/latest/bin/erl";
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl
index fc2cfd57bd..fc2cfd57bd 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/common_test/src/test_server_sup.erl
diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile
index ff4495b104..aa99fe1af1 100644
--- a/lib/common_test/test/Makefile
+++ b/lib/common_test/test/Makefile
@@ -65,9 +65,13 @@ MODULES= \
ct_cover_nomerge_SUITE \
ct_groups_search_SUITE \
ct_surefire_SUITE \
- ct_telnet_SUITE
+ ct_telnet_SUITE \
+ erl2html2_SUITE \
+ test_server_SUITE \
+ test_server_test_lib
ERL_FILES= $(MODULES:%=%.erl)
+HRL_FILES= test_server_test_lib.hrl
TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
INSTALL_PROGS= $(TARGET_FILES)
@@ -84,8 +88,8 @@ RELSYSDIR = $(RELEASE_PATH)/common_test_test
# FLAGS
# ----------------------------------------------------
-ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_MAKE_FLAGS +=
+ERL_COMPILE_FLAGS +=
EBIN = .
@@ -118,7 +122,7 @@ release_spec: opt
release_tests_spec:
$(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)"
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(COVERFILE) "$(RELSYSDIR)"
$(INSTALL_DATA) common_test.spec common_test.cover "$(RELSYSDIR)"
chmod -R u+w "$(RELSYSDIR)"
@tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
diff --git a/lib/common_test/test/common_test.cover b/lib/common_test/test/common_test.cover
index 87d00c420f..e8e01a9312 100644
--- a/lib/common_test/test/common_test.cover
+++ b/lib/common_test/test/common_test.cover
@@ -1,9 +1,2 @@
%% -*- erlang -*-
{incl_app,common_test,details}.
-{cross,common_test,[{test_server,[erl2html2,
- test_server,
- test_server_ctrl,
- test_server_gl,
- test_server_io,
- test_server_node,
- test_server_sup]}]}.
diff --git a/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl b/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl
index 28c85ee2db..29c25bf151 100644
--- a/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl
+++ b/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl
@@ -27,7 +27,7 @@
-behaviour(gen_event).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("common_test/include/ct_event.hrl").
%% gen_event callbacks
diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl
index f00b2bbb43..06bc0c07f4 100644
--- a/lib/common_test/test/ct_hooks_SUITE.erl
+++ b/lib/common_test/test/ct_hooks_SUITE.erl
@@ -30,7 +30,7 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("common_test/include/ct_event.hrl").
-define(eh, ct_test_support_eh).
diff --git a/lib/common_test/test/ct_master_SUITE.erl b/lib/common_test/test/ct_master_SUITE.erl
index 15b49c67c0..55837352e2 100644
--- a/lib/common_test/test/ct_master_SUITE.erl
+++ b/lib/common_test/test/ct_master_SUITE.erl
@@ -135,7 +135,7 @@ make_spec(DataDir, FileName, NodeNames, Suites, Config) ->
C = lists:map(
fun(NodeName) ->
- Rnd = random:uniform(2),
+ Rnd = rand:uniform(2),
if Rnd == 1->
{config,NodeName,filename:join(DataDir,
"master/config.txt")};
diff --git a/lib/common_test/test/ct_misc_1_SUITE.erl b/lib/common_test/test/ct_misc_1_SUITE.erl
index 1db8bcc794..a562719296 100644
--- a/lib/common_test/test/ct_misc_1_SUITE.erl
+++ b/lib/common_test/test/ct_misc_1_SUITE.erl
@@ -31,7 +31,6 @@
-compile(export_all).
-include_lib("common_test/include/ct.hrl").
--include_lib("test_server/include/test_server_line.hrl").
-include_lib("common_test/include/ct_event.hrl").
-define(eh, ct_test_support_eh).
diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl
index 248ec6c4df..4a47d345e9 100644
--- a/lib/common_test/test/ct_test_support.erl
+++ b/lib/common_test/test/ct_test_support.erl
@@ -414,14 +414,14 @@ ct_rpc({M,F,A}, Config) ->
%%%-----------------------------------------------------------------
%%% random_error/1
random_error(Config) when is_list(Config) ->
- random:seed(os:timestamp()),
+ rand:seed(exsplus),
Gen = fun(0,_) -> ok; (N,Fun) -> Fun(N-1, Fun) end,
- Gen(random:uniform(100), Gen),
+ Gen(rand:uniform(100), Gen),
ErrorTypes = ['BADMATCH','BADARG','CASE_CLAUSE','FUNCTION_CLAUSE',
'EXIT','THROW','UNDEF'],
- Type = lists:nth(random:uniform(length(ErrorTypes)), ErrorTypes),
- Where = case random:uniform(2) of
+ Type = lists:nth(rand:uniform(length(ErrorTypes)), ErrorTypes),
+ Where = case rand:uniform(2) of
1 ->
io:format("ct_test_support *returning* error of type ~w",
[Type]),
diff --git a/lib/common_test/test/ct_test_support_eh.erl b/lib/common_test/test/ct_test_support_eh.erl
index 7c3d137901..f3d933da04 100644
--- a/lib/common_test/test/ct_test_support_eh.erl
+++ b/lib/common_test/test/ct_test_support_eh.erl
@@ -27,7 +27,7 @@
-behaviour(gen_event).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("common_test/include/ct_event.hrl").
%% gen_event callbacks
diff --git a/lib/test_server/test/erl2html2_SUITE.erl b/lib/common_test/test/erl2html2_SUITE.erl
index 9e6389109b..9e6389109b 100644
--- a/lib/test_server/test/erl2html2_SUITE.erl
+++ b/lib/common_test/test/erl2html2_SUITE.erl
diff --git a/lib/test_server/test/erl2html2_SUITE_data/Makefile.src b/lib/common_test/test/erl2html2_SUITE_data/Makefile.src
index 942ac0584b..942ac0584b 100644
--- a/lib/test_server/test/erl2html2_SUITE_data/Makefile.src
+++ b/lib/common_test/test/erl2html2_SUITE_data/Makefile.src
diff --git a/lib/test_server/test/erl2html2_SUITE_data/header1.hrl b/lib/common_test/test/erl2html2_SUITE_data/header1.hrl
index 53d1b79ac5..53d1b79ac5 100644
--- a/lib/test_server/test/erl2html2_SUITE_data/header1.hrl
+++ b/lib/common_test/test/erl2html2_SUITE_data/header1.hrl
diff --git a/lib/test_server/test/erl2html2_SUITE_data/include/header2.hrl b/lib/common_test/test/erl2html2_SUITE_data/include/header2.hrl
index e69de29bb2..e69de29bb2 100644
--- a/lib/test_server/test/erl2html2_SUITE_data/include/header2.hrl
+++ b/lib/common_test/test/erl2html2_SUITE_data/include/header2.hrl
diff --git a/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl b/lib/common_test/test/erl2html2_SUITE_data/include/header3.hrl
index 2a20850a3a..2a20850a3a 100644
--- a/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl
+++ b/lib/common_test/test/erl2html2_SUITE_data/include/header3.hrl
diff --git a/lib/test_server/test/erl2html2_SUITE_data/m1.erl b/lib/common_test/test/erl2html2_SUITE_data/m1.erl
index 1d405963a5..1d405963a5 100644
--- a/lib/test_server/test/erl2html2_SUITE_data/m1.erl
+++ b/lib/common_test/test/erl2html2_SUITE_data/m1.erl
diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/common_test/test/test_server_SUITE.erl
index 6adf5b8a78..d1c789f34c 100644
--- a/lib/test_server/test/test_server_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE.erl
@@ -330,7 +330,7 @@ generate_and_run_unicode_test(Config0,Encoding) ->
%% Compile the suite
Node = proplists:get_value(node,Config),
- {ok,Mod} = rpc:call(Node,compile,file,[Suite,[{outdir,DataDir}]]),
+ {ok,Mod} = rpc:call(Node,compile,file,[Suite,[report,{outdir,DataDir}]]),
ModStr = atom_to_list(Mod),
%% Clean logdir
@@ -383,7 +383,7 @@ create_unicode_test_suite(Dir,Encoding) ->
"-export([init_per_testcase/2, end_per_testcase/2]).\n"
"-export([tc_äöå/1]).\n"
"\n"
- "-include_lib(\"test_server/include/test_server.hrl\").\n"
+ "-include_lib(\"common_test/include/ct.hrl\").\n"
"\n"
"all(suite) ->\n"
" [tc_äöå].\n"
diff --git a/lib/test_server/test/test_server_SUITE_data/Makefile.src b/lib/common_test/test/test_server_SUITE_data/Makefile.src
index 5aeb035572..5aeb035572 100644
--- a/lib/test_server/test/test_server_SUITE_data/Makefile.src
+++ b/lib/common_test/test/test_server_SUITE_data/Makefile.src
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE.erl
index 79d8defb22..c3d4315cb8 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE.erl
@@ -22,8 +22,7 @@
%%% Test Server self test.
%%%------------------------------------------------------------------
-module(test_server_SUITE).
--include_lib("test_server/include/test_server.hrl").
--include_lib("test_server/include/test_server_line.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
-export([all/1]).
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file
index 65c88fbd75..65c88fbd75 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_break_SUITE.erl
index ae9f018bc8..171f83df0f 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_break_SUITE.erl
@@ -28,7 +28,7 @@
break_in_end_tc_after_abort/1,
check_all_breaks/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
all(suite) ->
[break_in_init_tc,
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_conf01_SUITE.erl
index f634bc3a46..e4f40f6c03 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_conf01_SUITE.erl
@@ -22,7 +22,7 @@
%%% Test Server self test.
%%%------------------------------------------------------------------
-module(test_server_conf01_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile(export_all).
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_conf02_SUITE.erl
index f9cca8653b..1c6fe6dd0b 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_conf02_SUITE.erl
@@ -22,7 +22,7 @@
%%% Test Server self test.
%%%------------------------------------------------------------------
-module(test_server_conf02_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile(export_all).
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE.erl
index ab5ccec7a2..3371418980 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE.erl
@@ -23,7 +23,7 @@
-export([init_per_testcase/2, end_per_testcase/2]).
-export([tc1/1, tc2/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
all(suite) ->
[tc1,tc2].
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl
index 6c74eb4e8a..6c74eb4e8a 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl
index 0385435710..ad639b585d 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl
@@ -22,7 +22,7 @@
%%% Test Server self test.
%%%------------------------------------------------------------------
-module(test_server_parallel01_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile(export_all).
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl
index 847c7b6bdd..0f7118a810 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl
@@ -22,7 +22,7 @@
%%% Test Server self test.
%%%------------------------------------------------------------------
-module(test_server_shuffle01_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile(export_all).
@@ -224,7 +224,7 @@ conf5_end(_Config) ->
ok.
conf6_init(Config) when is_list(Config) ->
- [{shuffle,{_,_,_}}] = ?config(tc_group_properties,Config),
+ validate_shuffle(Config),
test_server:comment("Shuffle (random)"),
init = ?config(suite,Config),
[{cc6,conf6}|Config].
@@ -242,23 +242,28 @@ conf5(suite) -> % test specification
conf7_init(Config) when is_list(Config) ->
test_server:comment("Group 7, Shuffle (random seed)"),
- case proplists:get_value(shuffle,?config(tc_group_properties,Config)) of
- {_,_,_} -> ok
- end,
+ validate_shuffle(Config),
[{cc7,conf7}|Config].
conf7_end(_Config) ->
ok.
conf8_init(Config) when is_list(Config) ->
test_server:comment("Group 8, Shuffle (user start seed)"),
- case proplists:get_value(shuffle,?config(tc_group_properties,Config)) of
- {_,_,_} -> ok
- end,
+ validate_shuffle(Config),
init = ?config(suite,Config),
[{cc8,conf8}|Config].
conf8_end(_Config) ->
ok.
+validate_shuffle(Config) ->
+ case proplists:get_value(shuffle, ?config(tc_group_properties,Config)) of
+ {_,_,_} ->
+ ok;
+ Seed ->
+ %% Must be a valid seed.
+ _ = rand:seed_s(rand:export_seed_s(Seed))
+ end.
+
%%---------- test cases ----------
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_skip_SUITE.erl
index 871bd21ee7..ae2321c6ad 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_skip_SUITE.erl
@@ -22,8 +22,7 @@
-export([all/1, init_per_suite/1, end_per_suite/1]).
-export([dummy/1]).
--include_lib("test_server/include/test_server.hrl").
--include_lib("test_server/include/test_server_line.hrl").
+-include_lib("common_test/include/ct.hrl").
all(suite) ->
[dummy].
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_unicode_SUITE.erl
index 3a3366218b..0cabce995f 100644
--- a/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE_data/test_server_unicode_SUITE.erl
@@ -25,7 +25,7 @@
print_and_log_unicode/1,
print_and_log_latin1/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
all(suite) ->
['#=@: difficult_case_name_äöå',
diff --git a/lib/test_server/test/test_server_test_lib.erl b/lib/common_test/test/test_server_test_lib.erl
index e2680938e0..e2680938e0 100644
--- a/lib/test_server/test/test_server_test_lib.erl
+++ b/lib/common_test/test/test_server_test_lib.erl
diff --git a/lib/test_server/test/test_server_test_lib.hrl b/lib/common_test/test/test_server_test_lib.hrl
index 27b7be9618..27b7be9618 100644
--- a/lib/test_server/test/test_server_test_lib.hrl
+++ b/lib/common_test/test/test_server_test_lib.hrl
diff --git a/lib/webtool/src/Makefile b/lib/common_test/test_server/Makefile
index a5a8eaf5dc..0adf64b837 100644
--- a/lib/webtool/src/Makefile
+++ b/lib/common_test/test_server/Makefile
@@ -1,8 +1,8 @@
#
# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2001-2012. All Rights Reserved.
-#
+#
+# Copyright Ericsson AB 1996-2013. All Rights Reserved.
+#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
@@ -14,85 +14,83 @@
# WITHOUT WARRANTIES 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_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(WEBTOOL_VSN)
+include $(ERL_TOP)/make/target.mk
# ----------------------------------------------------
-# Release directory specification
+# Configuration info.
# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/webtool-$(VSN)
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
# ----------------------------------------------------
# Target Specs
# ----------------------------------------------------
-MODULES= webtool \
- webtool_sup
-
-
-
-ERL_FILES= $(MODULES:%=%.erl)
+EBIN=.
-TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+TS_MODULES= \
+ ts \
+ ts_run \
+ ts_lib \
+ ts_make \
+ ts_erl_config \
+ ts_autoconf_win32 \
+ ts_install \
+ ts_install_cth \
+ ts_benchmark
-APP_FILE= webtool.app
-APPUP_FILE= webtool.appup
+TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
+TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%)
-APP_SRC= $(APP_FILE).src
-APPUP_SRC= $(APPUP_FILE).src
+TS_ERL_FILES = $(TS_MODULES:=.erl)
+TS_HRL_FILES = ts.hrl
+AUTOCONF_FILES = configure.in conf_vars.in
+PROGRAMS = configure config.sub config.guess install-sh
+CONFIG = ts.config ts.unix.config ts.win32.config
+TS_TARGET_FILES = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR))
-APP_TARGET= $(EBIN)/$(APP_FILE)
-APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+TS_TARGETS = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR))
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
-ERL_COMPILE_FLAGS += +warn_obsolete_guard
-
+ERL_COMPILE_FLAGS += -I../include -Werror
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
+tests debug opt: $(TS_TARGETS)
clean:
- rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TS_TARGET_FILES)
rm -f core
docs:
+configure: configure.in
+ autoconf configure.in > configure
+
# ----------------------------------------------------
# Special Build Targets
# ----------------------------------------------------
-$(APP_TARGET): $(APP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_release_targets.mk
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) \
- "$(RELSYSDIR)/ebin"
+release_tests_spec: opt
+ $(INSTALL_DIR) "$(RELEASE_PATH)/test_server"
+ $(INSTALL_DATA) $(TS_ERL_FILES) $(TS_HRL_FILES) \
+ $(TS_TARGET_FILES) \
+ $(AUTOCONF_FILES) $(CONFIG) \
+ "$(RELEASE_PATH)/test_server"
+ $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server"
release_docs_spec:
diff --git a/lib/test_server/src/conf_vars.in b/lib/common_test/test_server/conf_vars.in
index 7c55d7b9ed..7c55d7b9ed 100644
--- a/lib/test_server/src/conf_vars.in
+++ b/lib/common_test/test_server/conf_vars.in
diff --git a/lib/test_server/src/configure.in b/lib/common_test/test_server/configure.in
index 001de72a1e..001de72a1e 100644
--- a/lib/test_server/src/configure.in
+++ b/lib/common_test/test_server/configure.in
diff --git a/lib/test_server/src/cross.cover b/lib/common_test/test_server/cross.cover
index 07bf0bed5c..07bf0bed5c 100644
--- a/lib/test_server/src/cross.cover
+++ b/lib/common_test/test_server/cross.cover
diff --git a/lib/test_server/src/ts.config b/lib/common_test/test_server/ts.config
index cf3d269616..cf3d269616 100644
--- a/lib/test_server/src/ts.config
+++ b/lib/common_test/test_server/ts.config
diff --git a/lib/test_server/src/ts.erl b/lib/common_test/test_server/ts.erl
index 8bbdc8f8cf..8bbdc8f8cf 100644
--- a/lib/test_server/src/ts.erl
+++ b/lib/common_test/test_server/ts.erl
diff --git a/lib/test_server/src/ts.hrl b/lib/common_test/test_server/ts.hrl
index 4c940fdc4f..4c940fdc4f 100644
--- a/lib/test_server/src/ts.hrl
+++ b/lib/common_test/test_server/ts.hrl
diff --git a/lib/test_server/src/ts.unix.config b/lib/common_test/test_server/ts.unix.config
index 1ba5d9033e..1ba5d9033e 100644
--- a/lib/test_server/src/ts.unix.config
+++ b/lib/common_test/test_server/ts.unix.config
diff --git a/lib/test_server/src/ts.win32.config b/lib/common_test/test_server/ts.win32.config
index cae587bea8..cae587bea8 100644
--- a/lib/test_server/src/ts.win32.config
+++ b/lib/common_test/test_server/ts.win32.config
diff --git a/lib/test_server/src/ts_autoconf_win32.erl b/lib/common_test/test_server/ts_autoconf_win32.erl
index 288305b406..288305b406 100644
--- a/lib/test_server/src/ts_autoconf_win32.erl
+++ b/lib/common_test/test_server/ts_autoconf_win32.erl
diff --git a/lib/test_server/src/ts_benchmark.erl b/lib/common_test/test_server/ts_benchmark.erl
index 3e55edefb0..3e55edefb0 100644
--- a/lib/test_server/src/ts_benchmark.erl
+++ b/lib/common_test/test_server/ts_benchmark.erl
diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/common_test/test_server/ts_erl_config.erl
index ab7363c106..ab7363c106 100644
--- a/lib/test_server/src/ts_erl_config.erl
+++ b/lib/common_test/test_server/ts_erl_config.erl
diff --git a/lib/test_server/src/ts_install.erl b/lib/common_test/test_server/ts_install.erl
index 600a576820..600a576820 100644
--- a/lib/test_server/src/ts_install.erl
+++ b/lib/common_test/test_server/ts_install.erl
diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/common_test/test_server/ts_install_cth.erl
index ec0d54ccde..ec0d54ccde 100644
--- a/lib/test_server/src/ts_install_cth.erl
+++ b/lib/common_test/test_server/ts_install_cth.erl
diff --git a/lib/test_server/src/ts_lib.erl b/lib/common_test/test_server/ts_lib.erl
index 7c3f450194..7c3f450194 100644
--- a/lib/test_server/src/ts_lib.erl
+++ b/lib/common_test/test_server/ts_lib.erl
diff --git a/lib/test_server/src/ts_make.erl b/lib/common_test/test_server/ts_make.erl
index 0178f4d836..921edb264a 100644
--- a/lib/test_server/src/ts_make.erl
+++ b/lib/common_test/test_server/ts_make.erl
@@ -21,7 +21,7 @@
-export([make/1,make/3,unmake/1]).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Functions to be called from make test cases.
diff --git a/lib/test_server/src/ts_run.erl b/lib/common_test/test_server/ts_run.erl
index 188094921d..188094921d 100644
--- a/lib/test_server/src/ts_run.erl
+++ b/lib/common_test/test_server/ts_run.erl
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 299b2892fc..f75beaba20 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -50,6 +50,7 @@ MODULES = \
beam_asm \
beam_block \
beam_bool \
+ beam_bs \
beam_bsm \
beam_clean \
beam_dead \
@@ -62,6 +63,7 @@ MODULES = \
beam_opcodes \
beam_peep \
beam_receive \
+ beam_reorder \
beam_split \
beam_trim \
beam_type \
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index a3201b0f4a..95be471de3 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -30,11 +30,12 @@
module(Code, Abst, SourceFile, Opts) ->
{ok,assemble(Code, Abst, SourceFile, Opts)}.
-assemble({Mod,Exp,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) ->
+assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) ->
{1,Dict0} = beam_dict:atom(Mod, beam_dict:new()),
{0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0),
NumFuncs = length(Asm0),
{Asm,Attr} = on_load(Asm0, Attr0),
+ Exp = cerl_sets:from_list(Exp0),
{Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts).
@@ -61,7 +62,7 @@ insert_on_load_instruction(Is0, Entry) ->
Bef ++ [El,on_load|Is].
assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) ->
- Dict1 = case member({Name,Arity}, Exp) of
+ Dict1 = case cerl_sets:is_element({Name,Arity}, Exp) of
true ->
beam_dict:export(Name, Arity, Entry, Dict0);
false ->
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 0321b1c07b..10dbaf462c 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -23,14 +23,13 @@
-module(beam_block).
-export([module/2]).
--import(lists, [mapfoldl/3,reverse/1,reverse/2,foldl/3,member/2]).
--define(MAXREG, 1024).
+-import(lists, [reverse/1,reverse/2,foldl/3,member/2]).
-module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) ->
- {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0),
+module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
+ Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
-function({function,Name,Arity,CLabel,Is0}, Lc0) ->
+function({function,Name,Arity,CLabel,Is0}) ->
try
%% Collect basic blocks and optimize them.
Is1 = blockify(Is0),
@@ -40,11 +39,8 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
Is5 = opt_blocks(Is4),
Is6 = beam_utils:delete_live_annos(Is5),
- %% Optimize bit syntax.
- {Is,Lc} = bsm_opt(Is6, Lc0),
-
%% Done.
- {{function,Name,Arity,CLabel,Is},Lc}
+ {function,Name,Arity,CLabel,Is6}
catch
Class:Error ->
Stack = erlang:get_stacktrace(),
@@ -62,56 +58,15 @@ blockify(Is) ->
blockify([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_Lbl},{label,Fail}|Is], Acc) ->
%% Useless instruction sequence.
blockify(Is, Acc);
-blockify([{test,is_atom,{f,Fail},[Reg]}=I|
- [{select,select_val,Reg,{f,Fail},
- [{atom,false},{f,_}=BrFalse,
- {atom,true}=AtomTrue,{f,_}=BrTrue]}|Is]=Is0],
- [{block,Bl}|_]=Acc) ->
- case is_last_bool(Bl, Reg) of
- false ->
- blockify(Is0, [I|Acc]);
- true ->
- %% The last instruction is a boolean operator/guard BIF that can't fail.
- %% We can convert the three-way branch to a two-way branch (eliminating
- %% the reference to the failure label).
- blockify(Is, [{jump,BrTrue},
- {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc])
- end;
-blockify([{test,is_atom,{f,Fail},[Reg]}=I|
- [{select,select_val,Reg,{f,Fail},
- [{atom,true}=AtomTrue,{f,_}=BrTrue,
- {atom,false},{f,_}=BrFalse]}|Is]=Is0],
- [{block,Bl}|_]=Acc) ->
- case is_last_bool(Bl, Reg) of
- false ->
- blockify(Is0, [I|Acc]);
- true ->
- blockify(Is, [{jump,BrTrue},
- {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc])
- end;
blockify([I|Is0]=IsAll, Acc) ->
- case is_bs_put(I) of
- true ->
- {BsPuts0,Is} = collect_bs_puts(IsAll),
- BsPuts = opt_bs_puts(BsPuts0),
- blockify(Is, reverse(BsPuts, Acc));
- false ->
- case collect(I) of
- error -> blockify(Is0, [I|Acc]);
- Instr when is_tuple(Instr) ->
- {Block,Is} = collect_block(IsAll),
- blockify(Is, [{block,Block}|Acc])
- end
+ case collect(I) of
+ error -> blockify(Is0, [I|Acc]);
+ Instr when is_tuple(Instr) ->
+ {Block,Is} = collect_block(IsAll),
+ blockify(Is, [{block,Block}|Acc])
end;
blockify([], Acc) -> reverse(Acc).
-is_last_bool([{set,[Reg],As,{bif,N,_}}], Reg) ->
- Ar = length(As),
- erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar)
- orelse erl_internal:bool_op(N, Ar);
-is_last_bool([_|Is], Reg) -> is_last_bool(Is, Reg);
-is_last_bool([], _) -> false.
-
collect_block(Is) ->
collect_block(Is, []).
@@ -149,7 +104,10 @@ collect({put_map,F,Op,S,D,R,{list,Puts}}) ->
collect({get_map_elements,F,S,{list,Gets}}) ->
{Ss,Ds} = beam_utils:split_even(Gets),
{set,Ds,[S|Ss],{get_map_elements,F}};
-collect({'catch',R,L}) -> {set,[R],[],{'catch',L}};
+collect({'catch'=Op,R,L}) ->
+ {set,[R],[],{try_catch,Op,L}};
+collect({'try'=Op,R,L}) ->
+ {set,[R],[],{try_catch,Op,L}};
collect(fclearerror) -> {set,[],[],fclearerror};
collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror};
collect({fmove,S,D}) -> {set,[D],[S],fmove};
@@ -183,7 +141,9 @@ opt_blocks([I|Is]) ->
opt_blocks([]) -> [].
opt_block(Is0) ->
- Is = find_fixpoint(fun opt/1, Is0),
+ Is = find_fixpoint(fun(Is) ->
+ opt_tuple_element(opt(Is))
+ end, Is0),
opt_alloc(Is).
find_fixpoint(OptFun, Is0) ->
@@ -279,76 +239,151 @@ opt_moves([X0,Y0], Is0) ->
not_possible -> {[X,Y0],Is2};
{X,_} -> {[X,Y0],Is2};
{Y,Is} -> {[X,Y],Is}
- end;
-opt_moves(Ds, Is) ->
- %% multiple destinations -> pass through
- {Ds,Is}.
-
+ end.
%% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible
%% If there is a {move,Dest,FinalDest} instruction
%% in the instruction stream, remove the move instruction
%% and let FinalDest be the destination.
-%%
-%% For this optimization to be safe, we must be sure that
-%% Dest will not be referenced in any other by other instructions
-%% in the rest of the instruction stream. Not even the indirect
-%% reference by an instruction that may allocate (such as
-%% test_heap/2 or a GC Bif) is allowed.
opt_move(Dest, Is) ->
- opt_move_1(Dest, Is, ?MAXREG, []).
-
-opt_move_1(R, [{set,_,_,{alloc,Live,_}}|_]=Is, SafeRegs, Acc) when Live < SafeRegs ->
- %% Downgrade number of safe regs and rescan the instruction, as it most probably
- %% is a gc_bif instruction.
- opt_move_1(R, Is, Live, Acc);
-opt_move_1(R, [{set,[{x,X}=D],[R],move}|Is], SafeRegs, Acc) ->
- case X < SafeRegs andalso beam_utils:is_killed_block(R, Is) of
- true -> opt_move_2(D, Acc, Is);
- false -> not_possible
+ opt_move_1(Dest, Is, []).
+
+opt_move_1(R, [{set,[D],[R],move}|Is0], Acc) ->
+ %% Provided that the source register is killed by instructions
+ %% that follow, the optimization is safe.
+ case eliminate_use_of_from_reg(Is0, R, D, []) of
+ {yes,Is} -> opt_move_rev(D, Acc, Is);
+ no -> not_possible
end;
-opt_move_1(R, [{set,[D],[R],move}|Is], _SafeRegs, Acc) ->
- case beam_utils:is_killed_block(R, Is) of
- true -> opt_move_2(D, Acc, Is);
- false -> not_possible
+opt_move_1({x,_}, [{set,_,_,{alloc,_,_}}|_], _) ->
+ %% The optimization is not possible. If the X register is not
+ %% killed by allocation, the optimization would not be safe.
+ %% If the X register is killed, it means that there cannot
+ %% follow a 'move' instruction with this X register as the
+ %% source.
+ not_possible;
+opt_move_1(R, [{set,_,_,_}=I|Is], Acc) ->
+ %% If the source register is either killed or used by this
+ %% instruction, the optimimization is not possible.
+ case is_killed_or_used(R, I) of
+ true -> not_possible;
+ false -> opt_move_1(R, Is, [I|Acc])
end;
-opt_move_1(R, [I|Is], SafeRegs, Acc) ->
- case is_transparent(R, I) of
- false -> not_possible;
- true -> opt_move_1(R, Is, SafeRegs, [I|Acc])
- end.
+opt_move_1(_, _, _) ->
+ not_possible.
+
+%% opt_tuple_element([Instruction]) -> [Instruction]
+%% If possible, move get_tuple_element instructions forward
+%% in the instruction stream to a move instruction, eliminating
+%% the move instruction. Example:
+%%
+%% get_tuple_element Tuple Pos Dst1
+%% ...
+%% move Dst1 Dst2
+%%
+%% This code may be possible to rewrite to:
+%%
+%% %%(Moved get_tuple_element instruction)
+%% ...
+%% get_tuple_element Tuple Pos Dst2
+%%
-%% Reverse the instructions, while checking that there are no instructions that
-%% would interfere with using the new destination register chosen.
+opt_tuple_element([{set,[D],[S],{get_tuple_element,_}}=I|Is0]) ->
+ case opt_tuple_element_1(Is0, I, {S,D}, []) of
+ no ->
+ [I|opt_tuple_element(Is0)];
+ {yes,Is} ->
+ opt_tuple_element(Is)
+ end;
+opt_tuple_element([I|Is]) ->
+ [I|opt_tuple_element(Is)];
+opt_tuple_element([]) -> [].
+
+opt_tuple_element_1([{set,_,_,{alloc,_,_}}|_], _, _, _) ->
+ no;
+opt_tuple_element_1([{set,_,_,{try_catch,_,_}}|_], _, _, _) ->
+ no;
+opt_tuple_element_1([{set,[D],[S],move}|Is0], I0, {_,S}, Acc) ->
+ case eliminate_use_of_from_reg(Is0, S, D, []) of
+ no ->
+ no;
+ {yes,Is} ->
+ {set,[S],Ss,Op} = I0,
+ I = {set,[D],Ss,Op},
+ {yes,reverse(Acc, [I|Is])}
+ end;
+opt_tuple_element_1([{set,Ds,Ss,_}=I|Is], MovedI, {S,D}=Regs, Acc) ->
+ case member(S, Ds) orelse member(D, Ss) of
+ true ->
+ no;
+ false ->
+ opt_tuple_element_1(Is, MovedI, Regs, [I|Acc])
+ end;
+opt_tuple_element_1(_, _, _, _) -> no.
+
+%% Reverse the instructions, while checking that there are no
+%% instructions that would interfere with using the new destination
+%% register (D).
-opt_move_2(D, [I|Is], Acc) ->
- case is_transparent(D, I) of
- false -> not_possible;
- true -> opt_move_2(D, Is, [I|Acc])
+opt_move_rev(D, [I|Is], Acc) ->
+ case is_killed_or_used(D, I) of
+ true -> not_possible;
+ false -> opt_move_rev(D, Is, [I|Acc])
+ end;
+opt_move_rev(D, [], Acc) -> {D,Acc}.
+
+%% is_killed_or_used(Register, {set,_,_,_}) -> bool()
+%% Test whether the register is used by the instruction.
+
+is_killed_or_used(R, {set,Ss,Ds,_}) ->
+ member(R, Ds) orelse member(R, Ss).
+
+%% eliminate_use_of_from_reg([Instruction], FromRegister, ToRegister, Acc) ->
+%% {yes,Is} | no
+%% Eliminate any use of FromRegister in the instruction sequence
+%% by replacing uses of FromRegister with ToRegister. If FromRegister
+%% is referenced by an allocation instruction, return 'no' to indicate
+%% that FromRegister is still used and that the optimization is not
+%% possible.
+
+eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) ->
+ if
+ X < Live ->
+ no;
+ true ->
+ {yes,reverse(Acc, Is0)}
end;
-opt_move_2(D, [], Acc) -> {D,Acc}.
-
-%% is_transparent(Register, Instruction) -> true | false
-%% Returns true if Instruction does not in any way references Register
-%% (even indirectly by an allocation instruction).
-%% Returns false if Instruction does reference Register, or we are
-%% not sure.
-
-is_transparent({x,X}, {set,_,_,{alloc,Live,_}}) when X < Live ->
- false;
-is_transparent(R, {set,Ds,Ss,_Op}) ->
- case member(R, Ds) of
- true -> false;
- false -> not member(R, Ss)
+eliminate_use_of_from_reg([{set,Ds,Ss0,Op}=I0|Is], From, To, Acc) ->
+ I = case member(From, Ss0) of
+ true ->
+ Ss = [case S of
+ From -> To;
+ _ -> S
+ end || S <- Ss0],
+ {set,Ds,Ss,Op};
+ false ->
+ I0
+ end,
+ case member(From, Ds) of
+ true ->
+ {yes,reverse(Acc, [I|Is])};
+ false ->
+ eliminate_use_of_from_reg(Is, From, To, [I|Acc])
end;
-is_transparent(_, _) -> false.
+eliminate_use_of_from_reg([I]=Is, From, _To, Acc) ->
+ case beam_utils:is_killed_block(From, [I]) of
+ true ->
+ {yes,reverse(Acc, Is)};
+ false ->
+ no
+ end.
%% opt_alloc(Instructions) -> Instructions'
%% Optimises all allocate instructions.
opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is]) ->
- [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|opt(Is)];
+ [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|Is];
opt_alloc([I|Is]) -> [I|opt_alloc(Is)];
opt_alloc([]) -> [].
@@ -414,234 +449,3 @@ x_dead([], Regs) -> Regs.
x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N));
x_live([_|Rs], Regs) -> x_live(Rs, Regs);
x_live([], Regs) -> Regs.
-
-%%%
-%%% Evaluation of constant bit fields.
-%%%
-
-is_bs_put({bs_put,_,{bs_put_integer,_,_},_}) -> true;
-is_bs_put({bs_put,_,{bs_put_float,_,_},_}) -> true;
-is_bs_put(_) -> false.
-
-collect_bs_puts(Is) ->
- collect_bs_puts_1(Is, []).
-
-collect_bs_puts_1([I|Is]=Is0, Acc) ->
- case is_bs_put(I) of
- false -> {reverse(Acc),Is0};
- true -> collect_bs_puts_1(Is, [I|Acc])
- end.
-
-opt_bs_puts(Is) ->
- opt_bs_1(Is, []).
-
-opt_bs_1([{bs_put,Fail,
- {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) ->
- try eval_put_float(Src, Sz, Flags0) of
- <<Int:Sz>> ->
- Flags = force_big(Flags0),
- I = {bs_put,Fail,{bs_put_integer,1,Flags},
- [{integer,Sz},{integer,Int}]},
- opt_bs_1([I|Is], Acc)
- catch
- error:_ ->
- opt_bs_1(Is, [I0|Acc])
- end;
-opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll,
- Acc0) ->
- {Is,Acc} = bs_collect_string(IsAll, Acc0),
- opt_bs_1(Is, Acc);
-opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0],
- Acc) when Sz > 8 ->
- case field_endian(F) of
- big ->
- %% We can do this optimization for any field size without risk
- %% for code explosion.
- case bs_split_int(N, Sz, Fail, Is0) of
- no_split -> opt_bs_1(Is0, [I|Acc]);
- Is -> opt_bs_1(Is, Acc)
- end;
- little when Sz < 128 ->
- %% We only try to optimize relatively small fields, to avoid
- %% an explosion in code size.
- <<Int:Sz>> = <<N:Sz/little>>,
- Flags = force_big(F),
- Is = [{bs_put,Fail,{bs_put_integer,1,Flags},
- [{integer,Sz},{integer,Int}]}|Is0],
- opt_bs_1(Is, Acc);
- _ -> %native or too wide little field
- opt_bs_1(Is0, [I|Acc])
- end;
-opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 ->
- opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc);
-opt_bs_1([I|Is], Acc) ->
- opt_bs_1(Is, [I|Acc]);
-opt_bs_1([], Acc) -> reverse(Acc).
-
-eval_put_float(Src, Sz, Flags) when Sz =< 256 -> %Only evaluate if Sz is reasonable.
- Val = value(Src),
- case field_endian(Flags) of
- little -> <<Val:Sz/little-float-unit:1>>;
- big -> <<Val:Sz/big-float-unit:1>>
- %% native intentionally not handled here - we can't optimize it.
- end.
-
-value({integer,I}) -> I;
-value({float,F}) -> F.
-
-bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) ->
- bs_coll_str_1(Is, Len, reverse(Str), Acc);
-bs_collect_string(Is, Acc) ->
- bs_coll_str_1(Is, 0, [], Acc).
-
-bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is],
- Len, StrAcc, IsAcc) when U*Sz =:= 8 ->
- Byte = V band 16#FF,
- bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc);
-bs_coll_str_1(Is, Len, StrAcc, IsAcc) ->
- {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}.
-
-field_endian({field_flags,F}) -> field_endian_1(F).
-
-field_endian_1([big=E|_]) -> E;
-field_endian_1([little=E|_]) -> E;
-field_endian_1([native=E|_]) -> E;
-field_endian_1([_|Fs]) -> field_endian_1(Fs).
-
-force_big({field_flags,F}) ->
- {field_flags,force_big_1(F)}.
-
-force_big_1([big|_]=Fs) -> Fs;
-force_big_1([little|Fs]) -> [big|Fs];
-force_big_1([F|Fs]) -> [F|force_big_1(Fs)].
-
-bs_split_int(0, Sz, _, _) when Sz > 64 ->
- %% We don't want to split in this case because the
- %% string will consist of only zeroes.
- no_split;
-bs_split_int(-1, Sz, _, _) when Sz > 64 ->
- %% We don't want to split in this case because the
- %% string will consist of only 255 bytes.
- no_split;
-bs_split_int(N, Sz, Fail, Acc) ->
- FirstByteSz = case Sz rem 8 of
- 0 -> 8;
- Rem -> Rem
- end,
- bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc).
-
-bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 ->
- I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}},
- [{integer,Sz},{integer,-1}]},
- [I|Acc];
-bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 ->
- I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}},
- [{integer,Sz},{integer,0}]},
- [I|Acc];
-bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 ->
- Mask = (1 bsl ByteSz) - 1,
- I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}},
- [{integer,ByteSz},{integer,N band Mask}]},
- bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]);
-bs_split_int_1(_, _, _, _, Acc) -> Acc.
-
-
-%%%
-%%% Optimization of new bit syntax matching: get rid
-%%% of redundant bs_restore2/2 instructions across select_val
-%%% instructions, as well as a few other simple peep-hole optimizations.
-%%%
-
-bsm_opt(Is0, Lc0) ->
- {Is1,D0,Lc} = bsm_scan(Is0, [], Lc0, []),
- Is2 = case D0 of
- [] ->
- Is1;
- _ ->
- D = gb_trees:from_orddict(orddict:from_list(D0)),
- bsm_reroute(Is1, D, none, [])
- end,
- Is = beam_clean:bs_clean_saves(Is2),
- {bsm_opt_2(Is, []),Lc}.
-
-bsm_scan([{label,L}=Lbl,{bs_restore2,_,Save}=R|Is], D0, Lc, Acc0) ->
- D = [{{L,Save},Lc}|D0],
- Acc = [{label,Lc},R,Lbl|Acc0],
- bsm_scan(Is, D, Lc+1, Acc);
-bsm_scan([I|Is], D, Lc, Acc) ->
- bsm_scan(Is, D, Lc, [I|Acc]);
-bsm_scan([], D, Lc, Acc) ->
- {reverse(Acc),D,Lc}.
-
-bsm_reroute([{bs_save2,Reg,Save}=I|Is], D, _, Acc) ->
- bsm_reroute(Is, D, {Reg,Save}, [I|Acc]);
-bsm_reroute([{bs_restore2,Reg,Save}=I|Is], D, _, Acc) ->
- bsm_reroute(Is, D, {Reg,Save}, [I|Acc]);
-bsm_reroute([{label,_}=I|Is], D, S, Acc) ->
- bsm_reroute(Is, D, S, [I|Acc]);
-bsm_reroute([{select,select_val,Reg,F0,Lbls0}|Is], D, {_,Save}=S, Acc0) ->
- [F|Lbls] = bsm_subst_labels([F0|Lbls0], Save, D),
- Acc = [{select,select_val,Reg,F,Lbls}|Acc0],
- bsm_reroute(Is, D, S, Acc);
-bsm_reroute([{test,TestOp,F0,TestArgs}=I|Is], D, {_,Save}=S, Acc0) ->
- F = bsm_subst_label(F0, Save, D),
- Acc = [{test,TestOp,F,TestArgs}|Acc0],
- case bsm_not_bs_test(I) of
- true ->
- %% The test instruction will not update the bit offset for the
- %% binary being matched. Therefore the save position can be kept.
- bsm_reroute(Is, D, S, Acc);
- false ->
- %% The test instruction might update the bit offset. Kill our
- %% remembered Save position.
- bsm_reroute(Is, D, none, Acc)
- end;
-bsm_reroute([{test,TestOp,F0,Live,TestArgs,Dst}|Is], D, {_,Save}, Acc0) ->
- F = bsm_subst_label(F0, Save, D),
- Acc = [{test,TestOp,F,Live,TestArgs,Dst}|Acc0],
- %% The test instruction will update the bit offset. Kill our
- %% remembered Save position.
- bsm_reroute(Is, D, none, Acc);
-bsm_reroute([{block,[{set,[],[],{alloc,_,_}}]}=Bl,
- {bs_context_to_binary,_}=I|Is], D, S, Acc) ->
- %% To help further bit syntax optimizations.
- bsm_reroute([I,Bl|Is], D, S, Acc);
-bsm_reroute([I|Is], D, _, Acc) ->
- bsm_reroute(Is, D, none, [I|Acc]);
-bsm_reroute([], _, _, Acc) -> reverse(Acc).
-
-bsm_opt_2([{test,bs_test_tail2,F,[Ctx,Bits]}|Is],
- [{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}|Acc]) ->
- bsm_opt_2(Is, [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|Acc]);
-bsm_opt_2([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,_]}|Is],
- [{test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,Flags]}|Acc]) ->
- bsm_opt_2(Is, [{test,bs_skip_bits2,F,
- [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]);
-bsm_opt_2([I|Is], Acc) ->
- bsm_opt_2(Is, [I|Acc]);
-bsm_opt_2([], Acc) -> reverse(Acc).
-
-%% bsm_not_bs_test({test,Name,_,Operands}) -> true|false.
-%% Test whether is the test is a "safe", i.e. does not move the
-%% bit offset for a binary.
-%%
-%% 'true' means that the test is safe, 'false' that we don't know or
-%% that the test moves the offset (e.g. bs_get_integer2).
-
-bsm_not_bs_test({test,bs_test_tail2,_,[_,_]}) -> true;
-bsm_not_bs_test(Test) -> beam_utils:is_pure_test(Test).
-
-bsm_subst_labels(Fs, Save, D) ->
- bsm_subst_labels_1(Fs, Save, D, []).
-
-bsm_subst_labels_1([F|Fs], Save, D, Acc) ->
- bsm_subst_labels_1(Fs, Save, D, [bsm_subst_label(F, Save, D)|Acc]);
-bsm_subst_labels_1([], _, _, Acc) ->
- reverse(Acc).
-
-bsm_subst_label({f,Lbl0}=F, Save, D) ->
- case gb_trees:lookup({Lbl0,Save}, D) of
- {value,Lbl} -> {f,Lbl};
- none -> F
- end;
-bsm_subst_label(Other, _, _) -> Other.
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index d14be83496..efd935f666 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -25,8 +25,6 @@
-import(lists, [reverse/1,reverse/2,foldl/3,mapfoldl/3,map/2]).
--define(MAXREG, 1024).
-
-record(st,
{next, %Next label number.
ll %Live regs at labels.
diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl
new file mode 100644
index 0000000000..55fa7ce10c
--- /dev/null
+++ b/lib/compiler/src/beam_bs.erl
@@ -0,0 +1,278 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Purpose : Partitions assembly instructions into basic blocks and
+%% optimizes them.
+
+-module(beam_bs).
+
+-export([module/2]).
+-import(lists, [mapfoldl/3,reverse/1]).
+
+module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) ->
+ {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0),
+ {ok,{Mod,Exp,Attr,Fs,Lc}}.
+
+function({function,Name,Arity,CLabel,Is0}, Lc0) ->
+ try
+ Is1 = bs_put_opt(Is0),
+ {Is,Lc} = bsm_opt(Is1, Lc0),
+ {{function,Name,Arity,CLabel,Is},Lc}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+%%%
+%%% Evaluation of constant bit fields.
+%%%
+
+bs_put_opt([{bs_put,_,_,_}=I|Is0]) ->
+ {BsPuts0,Is} = collect_bs_puts(Is0, [I]),
+ BsPuts = opt_bs_puts(BsPuts0),
+ BsPuts ++ bs_put_opt(Is);
+bs_put_opt([I|Is]) ->
+ [I|bs_put_opt(Is)];
+bs_put_opt([]) -> [].
+
+collect_bs_puts([{bs_put,_,_,_}=I|Is], Acc) ->
+ collect_bs_puts(Is, [I|Acc]);
+collect_bs_puts([_|_]=Is, Acc) ->
+ {reverse(Acc),Is}.
+
+opt_bs_puts(Is) ->
+ opt_bs_1(Is, []).
+
+opt_bs_1([{bs_put,Fail,
+ {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) ->
+ try eval_put_float(Src, Sz, Flags0) of
+ <<Int:Sz>> ->
+ Flags = force_big(Flags0),
+ I = {bs_put,Fail,{bs_put_integer,1,Flags},
+ [{integer,Sz},{integer,Int}]},
+ opt_bs_1([I|Is], Acc)
+ catch
+ error:_ ->
+ opt_bs_1(Is, [I0|Acc])
+ end;
+opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll,
+ Acc0) ->
+ {Is,Acc} = bs_collect_string(IsAll, Acc0),
+ opt_bs_1(Is, Acc);
+opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0],
+ Acc) when Sz > 8 ->
+ case field_endian(F) of
+ big ->
+ %% We can do this optimization for any field size without
+ %% risk for code explosion.
+ case bs_split_int(N, Sz, Fail, Is0) of
+ no_split -> opt_bs_1(Is0, [I|Acc]);
+ Is -> opt_bs_1(Is, Acc)
+ end;
+ little when Sz < 128 ->
+ %% We only try to optimize relatively small fields, to
+ %% avoid an explosion in code size.
+ <<Int:Sz>> = <<N:Sz/little>>,
+ Flags = force_big(F),
+ Is = [{bs_put,Fail,{bs_put_integer,1,Flags},
+ [{integer,Sz},{integer,Int}]}|Is0],
+ opt_bs_1(Is, Acc);
+ _ -> %native or too wide little field
+ opt_bs_1(Is0, [I|Acc])
+ end;
+opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 ->
+ opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc);
+opt_bs_1([I|Is], Acc) ->
+ opt_bs_1(Is, [I|Acc]);
+opt_bs_1([], Acc) -> reverse(Acc).
+
+eval_put_float(Src, Sz, Flags) when Sz =< 256 ->
+ %%Only evaluate if Sz is reasonable.
+ Val = value(Src),
+ case field_endian(Flags) of
+ little -> <<Val:Sz/little-float-unit:1>>;
+ big -> <<Val:Sz/big-float-unit:1>>
+ %% native intentionally not handled here - we can't optimize
+ %% it.
+ end.
+
+value({integer,I}) -> I;
+value({float,F}) -> F.
+
+bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) ->
+ bs_coll_str_1(Is, Len, reverse(Str), Acc);
+bs_collect_string(Is, Acc) ->
+ bs_coll_str_1(Is, 0, [], Acc).
+
+bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is],
+ Len, StrAcc, IsAcc) when U*Sz =:= 8 ->
+ Byte = V band 16#FF,
+ bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc);
+bs_coll_str_1(Is, Len, StrAcc, IsAcc) ->
+ {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}.
+
+field_endian({field_flags,F}) -> field_endian_1(F).
+
+field_endian_1([big=E|_]) -> E;
+field_endian_1([little=E|_]) -> E;
+field_endian_1([native=E|_]) -> E;
+field_endian_1([_|Fs]) -> field_endian_1(Fs).
+
+force_big({field_flags,F}) ->
+ {field_flags,force_big_1(F)}.
+
+force_big_1([big|_]=Fs) -> Fs;
+force_big_1([little|Fs]) -> [big|Fs];
+force_big_1([F|Fs]) -> [F|force_big_1(Fs)].
+
+bs_split_int(0, Sz, _, _) when Sz > 64 ->
+ %% We don't want to split in this case because the
+ %% string will consist of only zeroes.
+ no_split;
+bs_split_int(-1, Sz, _, _) when Sz > 64 ->
+ %% We don't want to split in this case because the
+ %% string will consist of only 255 bytes.
+ no_split;
+bs_split_int(N, Sz, Fail, Acc) ->
+ FirstByteSz = case Sz rem 8 of
+ 0 -> 8;
+ Rem -> Rem
+ end,
+ bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc).
+
+bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 ->
+ I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}},
+ [{integer,Sz},{integer,-1}]},
+ [I|Acc];
+bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 ->
+ I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}},
+ [{integer,Sz},{integer,0}]},
+ [I|Acc];
+bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 ->
+ Mask = (1 bsl ByteSz) - 1,
+ I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}},
+ [{integer,ByteSz},{integer,N band Mask}]},
+ bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]);
+bs_split_int_1(_, _, _, _, Acc) -> Acc.
+
+%%%
+%%% Optimization of bit syntax matching: get rid
+%%% of redundant bs_restore2/2 instructions across select_val
+%%% instructions, as well as a few other simple peep-hole
+%%% optimizations.
+%%%
+
+bsm_opt(Is0, Lc0) ->
+ {Is1,D0,Lc} = bsm_scan(Is0, [], Lc0, []),
+ Is2 = case D0 of
+ [] ->
+ %% No bit syntax matching in this function.
+ Is1;
+ [_|_] ->
+ %% Optimize the bit syntax matching.
+ D = gb_trees:from_orddict(orddict:from_list(D0)),
+ bsm_reroute(Is1, D, none, [])
+ end,
+ Is = beam_clean:bs_clean_saves(Is2),
+ {bsm_opt_2(Is, []),Lc}.
+
+bsm_scan([{label,L}=Lbl,{bs_restore2,_,Save}=R|Is], D0, Lc, Acc0) ->
+ D = [{{L,Save},Lc}|D0],
+ Acc = [{label,Lc},R,Lbl|Acc0],
+ bsm_scan(Is, D, Lc+1, Acc);
+bsm_scan([I|Is], D, Lc, Acc) ->
+ bsm_scan(Is, D, Lc, [I|Acc]);
+bsm_scan([], D, Lc, Acc) ->
+ {reverse(Acc),D,Lc}.
+
+bsm_reroute([{bs_save2,Reg,Save}=I|Is], D, _, Acc) ->
+ bsm_reroute(Is, D, {Reg,Save}, [I|Acc]);
+bsm_reroute([{bs_restore2,Reg,Save}=I|Is], D, _, Acc) ->
+ bsm_reroute(Is, D, {Reg,Save}, [I|Acc]);
+bsm_reroute([{label,_}=I|Is], D, S, Acc) ->
+ bsm_reroute(Is, D, S, [I|Acc]);
+bsm_reroute([{select,select_val,Reg,F0,Lbls0}|Is], D, {_,Save}=S, Acc0) ->
+ [F|Lbls] = bsm_subst_labels([F0|Lbls0], Save, D),
+ Acc = [{select,select_val,Reg,F,Lbls}|Acc0],
+ bsm_reroute(Is, D, S, Acc);
+bsm_reroute([{test,TestOp,F0,TestArgs}=I|Is], D, {_,Save}=S, Acc0) ->
+ F = bsm_subst_label(F0, Save, D),
+ Acc = [{test,TestOp,F,TestArgs}|Acc0],
+ case bsm_not_bs_test(I) of
+ true ->
+ %% The test instruction will not update the bit offset for
+ %% the binary being matched. Therefore the save position
+ %% can be kept.
+ bsm_reroute(Is, D, S, Acc);
+ false ->
+ %% The test instruction might update the bit offset. Kill
+ %% our remembered Save position.
+ bsm_reroute(Is, D, none, Acc)
+ end;
+bsm_reroute([{test,TestOp,F0,Live,TestArgs,Dst}|Is], D, {_,Save}, Acc0) ->
+ F = bsm_subst_label(F0, Save, D),
+ Acc = [{test,TestOp,F,Live,TestArgs,Dst}|Acc0],
+ %% The test instruction will update the bit offset. Kill our
+ %% remembered Save position.
+ bsm_reroute(Is, D, none, Acc);
+bsm_reroute([{block,[{set,[],[],{alloc,_,_}}]}=Bl,
+ {bs_context_to_binary,_}=I|Is], D, S, Acc) ->
+ %% To help further bit syntax optimizations.
+ bsm_reroute([I,Bl|Is], D, S, Acc);
+bsm_reroute([I|Is], D, _, Acc) ->
+ bsm_reroute(Is, D, none, [I|Acc]);
+bsm_reroute([], _, _, Acc) -> reverse(Acc).
+
+bsm_opt_2([{test,bs_test_tail2,F,[Ctx,Bits]}|Is],
+ [{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}|Acc]) ->
+ bsm_opt_2(Is, [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|Acc]);
+bsm_opt_2([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,_]}|Is],
+ [{test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,Flags]}|Acc]) ->
+ bsm_opt_2(Is, [{test,bs_skip_bits2,F,
+ [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]);
+bsm_opt_2([I|Is], Acc) ->
+ bsm_opt_2(Is, [I|Acc]);
+bsm_opt_2([], Acc) -> reverse(Acc).
+
+%% bsm_not_bs_test({test,Name,_,Operands}) -> true|false.
+%% Test whether is the test is a "safe", i.e. does not move the
+%% bit offset for a binary.
+%%
+%% 'true' means that the test is safe, 'false' that we don't know or
+%% that the test moves the offset (e.g. bs_get_integer2).
+
+bsm_not_bs_test({test,bs_test_tail2,_,[_,_]}) -> true;
+bsm_not_bs_test(Test) -> beam_utils:is_pure_test(Test).
+
+bsm_subst_labels(Fs, Save, D) ->
+ bsm_subst_labels_1(Fs, Save, D, []).
+
+bsm_subst_labels_1([F|Fs], Save, D, Acc) ->
+ bsm_subst_labels_1(Fs, Save, D, [bsm_subst_label(F, Save, D)|Acc]);
+bsm_subst_labels_1([], _, _, Acc) ->
+ reverse(Acc).
+
+bsm_subst_label({f,Lbl0}=F, Save, D) ->
+ case gb_trees:lookup({Lbl0,Save}, D) of
+ {value,Lbl} -> {f,Lbl};
+ none -> F
+ end;
+bsm_subst_label(Other, _, _) -> Other.
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 919ee3ee7d..d9108c383d 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -141,7 +141,7 @@ renumber_labels([{bif,is_record,{f,_},
renumber_labels(Is, Acc, St);
renumber_labels([{test,is_record,{f,_}=Fail,
[Term,{atom,Tag}=TagAtom,{integer,Arity}]}|Is0], Acc, St) ->
- Tmp = {x,1023},
+ Tmp = {x,1022},
Is = case is_record_tuple(Term, Tag, Arity) of
yes ->
Is0;
@@ -190,17 +190,11 @@ replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) ->
replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) ->
replace(Is, [{test,Test,{f,label(Lbl, D)},Live,Ops,Dst}|Acc], D);
replace([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D) ->
- Vls1 = map(fun ({f,L}) -> {f,label(L, D)};
- (Other) -> Other end, Vls0),
+ Vls = map(fun ({f,L}) -> {f,label(L, D)};
+ (Other) -> Other
+ end, Vls0),
Fail = label(Fail0, D),
- case redundant_values(Vls1, Fail, []) of
- [] ->
- %% Oops, no choices left. The loader will not accept that.
- %% Convert to a plain jump.
- replace(Is, [{jump,{f,Fail}}|Acc], D);
- Vls ->
- replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D)
- end;
+ replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D);
replace([{'try',R,{f,Lbl}}|Is], Acc, D) ->
replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D);
replace([{'catch',R,{f,Lbl}}|Is], Acc, D) ->
@@ -241,12 +235,6 @@ label(Old, D) ->
{value,Val} -> Val;
none -> throw({error,{undefined_label,Old}})
end.
-
-redundant_values([_,{f,Fail}|Vls], Fail, Acc) ->
- redundant_values(Vls, Fail, Acc);
-redundant_values([Val,Lbl|Vls], Fail, Acc) ->
- redundant_values(Vls, Fail, [Lbl,Val|Acc]);
-redundant_values([], _, Acc) -> reverse(Acc).
%%%
%%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index ead88b57e9..11129c39bc 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -239,11 +239,26 @@ backward([{test,is_eq_exact,Fail,[Dst,{integer,Arity}]}=I|
backward([{label,Lbl}=L|Is], D, Acc) ->
backward(Is, beam_utils:index_label(Lbl, Acc, D), [L|Acc]);
backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) ->
- List = shortcut_select_list(List0, Reg, D, []),
+ List1 = shortcut_select_list(List0, Reg, D, []),
Fail1 = shortcut_label(Fail0, D),
Fail = shortcut_bs_test(Fail1, Is, D),
- Sel = {select,select_val,Reg,{f,Fail},List},
- backward(Is, D, [Sel|Acc]);
+ List = prune_redundant(List1, Fail),
+ case List of
+ [] ->
+ Jump = {jump,{f,Fail}},
+ backward([Jump|Is], D, Acc);
+ [V,F] ->
+ Test = {test,is_eq_exact,{f,Fail},[Reg,V]},
+ Jump = {jump,F},
+ backward([Jump,Test|Is], D, Acc);
+ [{atom,B1},F,{atom,B2},F] when B1 =:= not B2 ->
+ Test = {test,is_boolean,{f,Fail},[Reg]},
+ Jump = {jump,F},
+ backward([Jump,Test|Is], D, Acc);
+ [_|_] ->
+ Sel = {select,select_val,Reg,{f,Fail},List},
+ backward(Is, D, [Sel|Acc])
+ end;
backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) ->
To = shortcut_select_label(To0, Reg, Src, D),
Jump = {jump,{f,To}},
@@ -257,14 +272,17 @@ backward([{jump,{f,To}}=J|[{bif,Op,_,Ops,Reg}|Is]=Is0], D, Acc) ->
catch
throw:not_possible -> backward(Is0, D, [J|Acc])
end;
-backward([{test,bs_start_match2,F,_,[R,_],Ctxt}=I|Is], D,
+backward([{test,bs_start_match2,F,Live,[R,_]=Args,Ctxt}|Is], D,
[{test,bs_match_string,F,[Ctxt,Bs]},
{test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) ->
+ {f,To0} = F,
+ To = shortcut_bs_start_match(To0, R, D),
case beam_utils:is_killed(Ctxt, Acc0, D) of
true ->
- Eq = {test,is_eq_exact,F,[R,{literal,Bs}]},
+ Eq = {test,is_eq_exact,{f,To},[R,{literal,Bs}]},
backward(Is, D, [Eq|Acc0]);
false ->
+ I = {test,bs_start_match2,{f,To},Live,Args,Ctxt},
backward(Is, D, [I|Acc])
end;
backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) ->
@@ -295,7 +313,28 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
is_eq_exact -> combine_eqs(To, Ops0, D, Acc);
_ -> {test,Op,{f,To},Ops0}
end,
- backward(Is, D, [I|Acc]);
+ case {I,Acc} of
+ {{test,is_atom,Fail,Ops0},[{test,is_boolean,Fail,Ops0}|_]} ->
+ %% An is_atom test before an is_boolean test (with the
+ %% same failure label) is redundant.
+ backward(Is, D, Acc);
+ {{test,is_atom,Fail,[R]},
+ [{test,is_eq_exact,Fail,[R,{atom,_}]}|_]} ->
+ %% An is_atom test before a comparison with an atom (with
+ %% the same failure label) is redundant.
+ backward(Is, D, Acc);
+ {{test,is_integer,Fail,[R]},
+ [{test,is_eq_exact,Fail,[R,{integer,_}]}|_]} ->
+ %% An is_integer test before a comparison with an integer
+ %% (with the same failure label) is redundant.
+ backward(Is, D, Acc);
+ {{test,_,_,_},_} ->
+ %% Still a test instruction. Done.
+ backward(Is, D, [I|Acc]);
+ {_,_} ->
+ %% Rewritten to a select_val. Rescan.
+ backward([I|Is], D, Acc)
+ end;
backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
To2 = shortcut_label(To1, D),
@@ -348,6 +387,12 @@ shortcut_label(To0, D) ->
shortcut_select_label(To, Reg, Lit, D) ->
shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D).
+prune_redundant([_,{f,Fail}|T], Fail) ->
+ prune_redundant(T, Fail);
+prune_redundant([V,F|T], Fail) ->
+ [V,F|prune_redundant(T, Fail)];
+prune_redundant([], _) -> [].
+
%% Replace a comparison operator with a test instruction and a jump.
%% For example, if we have this code:
%%
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index 2b5f8c1b7f..654fb47dbd 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -44,7 +44,7 @@
locals = [] :: [{label(), arity(), label()}],
imports = gb_trees:empty() :: import_tab(),
strings = <<>> :: binary(), %String pool
- lambdas = [], %[{...}]
+ lambdas = {0,[]}, %[{...}]
literals = dict:new() :: literal_tab(),
fnames = #{} :: fname_tab(),
lines = #{} :: line_tab(),
@@ -145,15 +145,14 @@ string(Str, Dict) when is_list(Str) ->
-spec lambda(label(), non_neg_integer(), bdict()) ->
{non_neg_integer(), bdict()}.
-lambda(Lbl, NumFree, #asm{lambdas=Lambdas0}=Dict) ->
- OldIndex = length(Lambdas0),
+lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) ->
%% Set Index the same as OldIndex.
Index = OldIndex,
%% Initialize OldUniq to 0. It will be set to an unique value
%% based on the MD5 checksum of the BEAM code for the module.
OldUniq = 0,
Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0],
- {OldIndex,Dict#asm{lambdas=Lambdas}}.
+ {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}.
%% Returns the index for a literal (adding it to the literal table if necessary).
%% literal(Literal, Dict) -> {Index,Dict'}
@@ -236,13 +235,13 @@ string_table(#asm{strings=Strings,string_offset=Size}) ->
-spec lambda_table(bdict()) -> {non_neg_integer(), [<<_:192>>]}.
-lambda_table(#asm{locals=Loc0,lambdas=Lambdas0}) ->
+lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) ->
Lambdas1 = sofs:relation(Lambdas0),
Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]),
Lambdas2 = sofs:relative_product1(Lambdas1, Loc),
Lambdas = [<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32>> ||
{{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)],
- {length(Lambdas),Lambdas}.
+ {NumLambdas,Lambdas}.
%% Returns the literal table.
%% literal_table(Dict) -> {NumLiterals, [<<TermSize>>,TermInExternalFormat]}
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 5e58e0f6ac..3b6eb19fe8 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -495,7 +495,7 @@ is_label_used_in_block({set,_,_,Info}, Lbl) ->
{alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl;
{alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl;
{get_map_elements,{f,F}} -> F =:= Lbl;
- {'catch',{f,F}} -> F =:= Lbl;
+ {try_catch,_,{f,F}} -> F =:= Lbl;
{alloc,_,_} -> false;
{put_tuple,_} -> false;
{get_tuple_element,_} -> false;
diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
index 17fd2e502a..0c1abfe6a0 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -65,18 +65,6 @@ function({function,Name,Arity,CLabel,Is0}) ->
%% InEncoding =:= latin1, OutEncoding =:= unicode;
%% InEncoding =:= latin1, OutEncoding =:= utf8 ->
%%
-%% (2) A select_val/4 instruction that only verifies that
-%% its argument is either 'true' or 'false' can be
-%% be replaced with an is_boolean/2 instruction. That is:
-%%
-%% select_val Reg Fail [ true Next false Next ]
-%% Next: ...
-%%
-%% can be rewritten to
-%%
-%% is_boolean Fail Reg
-%% Next: ...
-%%
peep(Is) ->
peep(Is, gb_sets:empty(), []).
@@ -95,12 +83,16 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
%% Kill all remembered tests that depend on the destination register.
SeenTests = kill_seen(Dst, SeenTests0),
peep(Is, SeenTests, [I|Acc]);
-peep([{test,is_boolean,{f,Fail},Ops}|_]=Is, SeenTests,
- [{test,is_atom,{f,Fail},Ops}|Acc]) ->
- %% The previous is_atom/2 test (with the same failure label) is redundant.
- %% (If is_boolean(Src) is true, is_atom(Src) is also true, so it is
- %% OK to still remember that we have seen is_atom/1.)
- peep(Is, SeenTests, Acc);
+peep([{select,Op,R,F,Vls0}|Is], _, Acc) ->
+ case prune_redundant_values(Vls0, F) of
+ [] ->
+ %% No values left. Must convert to plain jump.
+ I = {jump,F},
+ peep(Is, gb_sets:empty(), [I|Acc]);
+ [_|_]=Vls ->
+ I = {select,Op,R,F,Vls},
+ peep(Is, gb_sets:empty(), [I|Acc])
+ end;
peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
case beam_utils:is_pure_test(I) of
false ->
@@ -121,16 +113,6 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
peep(Is, SeenTests, [I|Acc])
end
end;
-peep([{select,select_val,Src,Fail,
- [{atom,false},{f,L},{atom,true},{f,L}]}|
- [{label,L}|_]=Is], SeenTests, Acc) ->
- I = {test,is_boolean,Fail,[Src]},
- peep([I|Is], SeenTests, Acc);
-peep([{select,select_val,Src,Fail,
- [{atom,true},{f,L},{atom,false},{f,L}]}|
- [{label,L}|_]=Is], SeenTests, Acc) ->
- I = {test,is_boolean,Fail,[Src]},
- peep([I|Is], SeenTests, Acc);
peep([I|Is], _, Acc) ->
%% An unknown instruction. Throw away all information we
%% have collected about test instructions.
@@ -155,3 +137,9 @@ kill_seen_1([{_,Ops}=Test|T], Dst) ->
false -> [Test|kill_seen_1(T, Dst)]
end;
kill_seen_1([], _) -> [].
+
+prune_redundant_values([_Val,F|Vls], F) ->
+ prune_redundant_values(Vls, F);
+prune_redundant_values([Val,Lbl|Vls], F) ->
+ [Val,Lbl|prune_redundant_values(Vls, F)];
+prune_redundant_values([], _) -> [].
diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl
new file mode 100644
index 0000000000..41586a7bf2
--- /dev/null
+++ b/lib/compiler/src/beam_reorder.erl
@@ -0,0 +1,139 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(beam_reorder).
+
+-export([module/2]).
+-import(lists, [member/2,reverse/1]).
+
+module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
+ Fs = [function(F) || F <- Fs0],
+ {ok,{Mod,Exp,Attr,Fs,Lc}}.
+
+function({function,Name,Arity,CLabel,Is0}) ->
+ try
+ Is = reorder(Is0),
+ {function,Name,Arity,CLabel,Is}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+%% reorder(Instructions0) -> Instructions
+%% Reorder instructions before the beam_block pass, because reordering
+%% will be more cumbersome when the blocks are in place.
+%%
+%% Execution of get_tuple_element instructions can be delayed until
+%% they are actually needed. Consider the sequence:
+%%
+%% get_tuple_element Tuple Pos Dst
+%% test Test Fail Operands
+%%
+%% If Dst is killed at label Fail (and not referenced in Operands),
+%% we can can swap the instructions:
+%%
+%% test Test Fail Operands
+%% get_tuple_element Tuple Pos Dst
+%%
+%% That can be beneficial in two ways: Firstly, if the branch is taken
+%% we have avoided execution of the get_tuple_element instruction.
+%% Secondly, even if the branch is not taken, subsequent optimization
+%% (opt_blocks/1) may be able to change Dst to the final destination
+%% register and eliminate a 'move' instruction.
+
+reorder(Is) ->
+ D = beam_utils:index_labels(Is),
+ reorder_1(Is, D, []).
+
+reorder_1([{Op,_,_}=TryCatch|[I|Is]=Is0], D, Acc)
+ when Op =:= 'catch'; Op =:= 'try' ->
+ %% Don't allow 'try' or 'catch' instructions to split blocks if
+ %% it can be avoided.
+ case is_safe(I) of
+ false ->
+ reorder_1(Is0, D, [TryCatch|Acc]);
+ true ->
+ reorder_1([TryCatch|Is], D, [I|Acc])
+ end;
+reorder_1([{label,L}=I|_], D, Acc) ->
+ Is = beam_utils:code_at(L, D),
+ reorder_1(Is, D, [I|Acc]);
+reorder_1([{test,is_nonempty_list,_,_}=I|Is], D, Acc) ->
+ %% The run-time system may combine the is_nonempty_list test with
+ %% the following get_list instruction.
+ reorder_1(Is, D, [I|Acc]);
+reorder_1([{test,_,_,_}=I,
+ {select,_,_,_,_}=S|Is], D, Acc) ->
+ %% There is nothing to gain by inserting a get_tuple_element
+ %% instruction between the test instruction and the select
+ %% instruction.
+ reorder_1(Is, D, [S,I|Acc]);
+reorder_1([{test,_,{f,L},Ss}=I|Is0], D0,
+ [{get_tuple_element,_,_,El}=G|Acc0]=Acc) ->
+ case member(El, Ss) of
+ true ->
+ reorder_1(Is0, D0, [I|Acc]);
+ false ->
+ case beam_utils:is_killed_at(El, L, D0) of
+ true ->
+ Is = [I,G|Is0],
+ reorder_1(Is, D0, Acc0);
+ false ->
+ case beam_utils:is_killed(El, Is0, D0) of
+ true ->
+ Code0 = beam_utils:code_at(L, D0),
+ Code = [G|Code0],
+ D = beam_utils:index_label(L, Code, D0),
+ Is = [I|Is0],
+ reorder_1(Is, D, Acc0);
+ false ->
+ reorder_1(Is0, D0, [I|Acc])
+ end
+ end
+ end;
+reorder_1([{allocate_zero,N,Live}=I0|Is], D,
+ [{get_tuple_element,{x,Tup},_,{x,Dst}}=G|Acc]=Acc0) ->
+ case Tup < Dst andalso Dst+1 =:= Live of
+ true ->
+ %% Move allocation instruction upwards past
+ %% get_tuple_element instructions to create more
+ %% opportunities for moving get_tuple_element
+ %% instructions.
+ I = {allocate_zero,N,Dst},
+ reorder_1([I,G|Is], D, Acc);
+ false ->
+ reorder_1(Is, D, [I0|Acc0])
+ end;
+reorder_1([I|Is], D, Acc) ->
+ reorder_1(Is, D, [I|Acc]);
+reorder_1([], _, Acc) -> reverse(Acc).
+
+%% is_safe(Instruction) -> true|false
+%% Test whether an instruction is safe (cannot cause an exception).
+
+is_safe({kill,_}) -> true;
+is_safe({move,_,_}) -> true;
+is_safe({put,_}) -> true;
+is_safe({put_list,_,_,_}) -> true;
+is_safe({put_tuple,_,_}) -> true;
+is_safe({test_heap,_,_}) -> true;
+is_safe(_) -> false.
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
index 3be9311080..bb1c0e23a9 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -57,8 +57,8 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is],
split_block([{set,Ds,[S|Ss],{get_map_elements,Fail}}|Is], Bl, Acc) ->
Gets = beam_utils:join_even(Ss,Ds),
split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]);
-split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) ->
- split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]);
+split_block([{set,[R],[],{try_catch,Op,L}}|Is], Bl, Acc) ->
+ split_block(Is, [], [{Op,R,L}|make_block(Bl, Acc)]);
split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) ->
split_block(Is, [], [Line|make_block(Bl, Acc)]);
split_block([I|Is], Bl, Acc) ->
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 5298589f83..4b45c28623 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -23,7 +23,8 @@
-export([module/2]).
--import(lists, [foldl/3,reverse/1,filter/2]).
+-import(lists, [filter/2,foldl/3,keyfind/3,member/2,
+ reverse/1,reverse/2,sort/1]).
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
Fs = [function(F) || F <- Fs0],
@@ -92,8 +93,19 @@ simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) -
Ts = update(I, Ts0),
simplify_basic_1(Is0, Ts, [I|Acc])
end;
-simplify_basic_1([{set,_,_,{'catch',_}}=I|Is], _Ts, Acc) ->
+simplify_basic_1([{set,_,_,{try_catch,_,_}}=I|Is], _Ts, Acc) ->
simplify_basic_1(Is, tdb_new(), [I|Acc]);
+simplify_basic_1([{test,is_atom,_,[R]}=I|Is], Ts, Acc) ->
+ case tdb_find(R, Ts) of
+ boolean -> simplify_basic_1(Is, Ts, Acc);
+ _ -> simplify_basic_1(Is, Ts, [I|Acc])
+ end;
+simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) ->
+ case tdb_find(R, Ts) of
+ integer -> simplify_basic_1(Is, Ts, Acc);
+ {integer,_} -> simplify_basic_1(Is, Ts, Acc);
+ _ -> simplify_basic_1(Is, Ts, [I|Acc])
+ end;
simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) ->
case tdb_find(R, Ts) of
{tuple,_,_} -> simplify_basic_1(Is, Ts, Acc);
@@ -137,6 +149,16 @@ simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc])
end;
+simplify_basic_1([{select,select_val,Reg,_,_}=I0|Is], Ts, Acc) ->
+ I = case tdb_find(Reg, Ts) of
+ {integer,Range} ->
+ simplify_select_val_int(I0, Range);
+ boolean ->
+ simplify_select_val_bool(I0);
+ _ ->
+ I0
+ end,
+ simplify_basic_1(Is, tdb_new(), [I|Acc]);
simplify_basic_1([I|Is], Ts0, Acc) ->
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc]);
@@ -144,6 +166,32 @@ simplify_basic_1([], Ts, Acc) ->
Is = reverse(Acc),
{Is,Ts}.
+simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) ->
+ Vs = sort([V || {integer,V} <- L0]),
+ case eq_ranges(Vs, Min, Max) of
+ false -> I;
+ true -> simplify_select_val_1(L0, {integer,Max}, R, [])
+ end.
+
+simplify_select_val_bool({select,select_val,R,_,L}=I) ->
+ Vs = sort([V || {atom,V} <- L]),
+ case Vs of
+ [false,true] ->
+ simplify_select_val_1(L, {atom,false}, R, []);
+ _ ->
+ I
+ end.
+
+simplify_select_val_1([Val,F|T], Val, R, Acc) ->
+ L = reverse(Acc, T),
+ {select,select_val,R,F,L};
+simplify_select_val_1([V,F|T], Val, R, Acc) ->
+ simplify_select_val_1(T, Val, R, [F,V|Acc]).
+
+eq_ranges([H], H, H) -> true;
+eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max);
+eq_ranges(_, _, _) -> false.
+
%% simplify_float([Instruction], TypeDatabase) ->
%% {[Instruction],TypeDatabase'} | not_possible
%% Simplify floating point operations in blocks.
@@ -199,7 +247,7 @@ simplify_float_1([{set,[D0],[A0,B0],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0,
Ts = tdb_update([{D0,float}], Ts0),
simplify_float_1(Is, Ts, Rs, Acc)
end;
-simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) ->
+simplify_float_1([{set,_,_,{try_catch,_,_}}=I|Is]=Is0, _Ts, Rs0, Acc0) ->
Acc = flush_all(Rs0, Is0, Acc0),
simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]);
simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) ->
@@ -311,7 +359,7 @@ flt_need_heap_2({set,_,_,{get_tuple_element,_}}, H, Fl) ->
{[],H,Fl};
flt_need_heap_2({set,_,_,get_list}, H, Fl) ->
{[],H,Fl};
-flt_need_heap_2({set,_,_,{'catch',_}}, H, Fl) ->
+flt_need_heap_2({set,_,_,{try_catch,_,_}}, H, Fl) ->
{[],H,Fl};
%% All other instructions should cause the insertion of an allocation
%% instruction if needed.
@@ -382,6 +430,17 @@ update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) ->
tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0);
update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) ->
tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0);
+update({set,[D],Args,{bif,N,_}}, Ts0) ->
+ Ar = length(Args),
+ BoolOp = erl_internal:new_type_test(N, Ar) orelse
+ erl_internal:comp_op(N, Ar) orelse
+ erl_internal:bool_op(N, Ar),
+ case BoolOp of
+ true ->
+ tdb_update([{D,boolean}], Ts0);
+ false ->
+ tdb_update([{D,kill}], Ts0)
+ end;
update({set,[D],[S],{get_tuple_element,0}}, Ts) ->
tdb_update([{D,{tuple_element,S,0}}], Ts);
update({set,[D],[S],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) ->
@@ -390,6 +449,13 @@ update({set,[D],[S],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) ->
true -> tdb_update([{D,float}], Ts0);
false -> Ts0
end;
+update({set,[D],[S1,S2],{alloc,_,{gc_bif,'band',{f,0}}}}, Ts) ->
+ case keyfind(integer, 1, [S1,S2]) of
+ {integer,N} ->
+ update_band(N, D, Ts);
+ false ->
+ tdb_update([{D,integer}], Ts)
+ end;
update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts0) ->
%% Make sure we reject non-numeric literals.
case possibly_numeric(S1) andalso possibly_numeric(S2) of
@@ -397,15 +463,17 @@ update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts0) ->
false -> Ts0
end;
update({set,[D],[S1,S2],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts0) ->
- case arith_op(Op) of
- no ->
- tdb_update([{D,kill}], Ts0);
- {yes,_} ->
+ case op_type(Op) of
+ integer ->
+ tdb_update([{D,integer}], Ts0);
+ {float,_} ->
case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of
{float,_} -> tdb_update([{D,float}], Ts0);
{_,float} -> tdb_update([{D,float}], Ts0);
{_,_} -> tdb_update([{D,kill}], Ts0)
- end
+ end;
+ unknown ->
+ tdb_update([{D,kill}], Ts0)
end;
update({set,[],_Src,_Op}, Ts0) -> Ts0;
update({set,[D],_Src,_Op}, Ts0) ->
@@ -437,6 +505,8 @@ update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) ->
tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts);
update({test,_Test,_Fail,_Other}, Ts) ->
Ts;
+update({test,bs_get_integer2,_,_,Args,Dst}, Ts) ->
+ tdb_update([{Dst,get_bs_integer_type(Args)}], Ts);
update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) ->
case is_math_bif(Math, Ar) of
true -> tdb_update([{{x,0},float}], Ts);
@@ -453,10 +523,43 @@ update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts);
update({line,_}, Ts) -> Ts;
+update({bs_save2,_,_}, Ts) -> Ts;
+update({bs_restore2,_,_}, Ts) -> Ts;
%% The instruction is unknown. Kill all information.
update(_I, _Ts) -> tdb_new().
+update_band(N, Reg, Ts) ->
+ Type = update_band_1(N, 0),
+ tdb_update([{Reg,Type}], Ts).
+
+update_band_1(N, Bits) when Bits < 64 ->
+ case 1 bsl Bits of
+ P when P =:= N + 1 ->
+ {integer,{0,N}};
+ P when P > N + 1 ->
+ integer;
+ _ ->
+ update_band_1(N, Bits+1)
+ end;
+update_band_1(_, _) ->
+ %% Negative or large positive number. Give up.
+ integer.
+
+get_bs_integer_type([_,{integer,N},U,{field_flags,Fl}])
+ when N*U < 64 ->
+ NumBits = N*U,
+ case member(unsigned, Fl) of
+ true ->
+ {integer,{0,(1 bsl NumBits)-1}};
+ false ->
+ %% Signed integer. Don't bother.
+ integer
+ end;
+get_bs_integer_type(_) ->
+ %% Avoid creating ranges with a huge upper limit.
+ integer.
+
is_math_bif(cos, 1) -> true;
is_math_bif(cosh, 1) -> true;
is_math_bif(sin, 1) -> true;
@@ -545,11 +648,22 @@ load_reg(V, Ts, Rs0, Is0) ->
{Rs,Is}
end.
-arith_op('+') -> {yes,fadd};
-arith_op('-') -> {yes,fsub};
-arith_op('*') -> {yes,fmul};
-arith_op('/') -> {yes,fdiv};
-arith_op(_) -> no.
+arith_op(Op) ->
+ case op_type(Op) of
+ {float,Instr} -> {yes,Instr};
+ _ -> no
+ end.
+
+op_type('+') -> {float,fadd};
+op_type('-') -> {float,fsub};
+op_type('*') -> {float,fmul};
+%% '/' and 'band' are specially handled.
+op_type('bor') -> integer;
+op_type('bxor') -> integer;
+op_type('bsl') -> integer;
+op_type('bsr') -> integer;
+op_type('div') -> integer;
+op_type(_) -> unknown.
flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) ->
Acc = flush_all(Rs, Is0, Acc0),
@@ -618,7 +732,6 @@ checkerror(Is) ->
checkerror_1(Is, Is).
checkerror_1([{set,[],[],fcheckerror}|_], OrigIs) -> OrigIs;
-checkerror_1([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs;
checkerror_1([{set,_,_,{bif,fadd,_}}|_], OrigIs) -> checkerror_2(OrigIs);
checkerror_1([{set,_,_,{bif,fsub,_}}|_], OrigIs) -> checkerror_2(OrigIs);
checkerror_1([{set,_,_,{bif,fmul,_}}|_], OrigIs) -> checkerror_2(OrigIs);
@@ -640,6 +753,9 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs].
%%% of the first element).
%%%
%%% 'float' means that the register contains a float.
+%%%
+%%% 'integer' or {integer,{Min,Max}} that the register contains an
+%%% integer.
%% tdb_new() -> EmptyDataBase
%% Creates a new, empty type database.
@@ -729,10 +845,20 @@ merge_type_info({tuple,Sz1,[]}, {tuple,_Sz2,First}=Tuple2) ->
merge_type_info({tuple,Sz1,First}, Tuple2);
merge_type_info({tuple,_Sz1,First}=Tuple1, {tuple,Sz2,_}) ->
merge_type_info(Tuple1, {tuple,Sz2,First});
+merge_type_info(integer, {integer,_}=Int) ->
+ Int;
+merge_type_info({integer,_}=Int, integer) ->
+ Int;
+merge_type_info({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) ->
+ {integer,{max(Min1, Min2),min(Max1, Max2)}};
merge_type_info(NewType, _) ->
verify_type(NewType),
NewType.
+verify_type(boolean) -> ok;
+verify_type(integer) -> ok;
+verify_type({integer,{Min,Max}})
+ when is_integer(Min), is_integer(Max) -> ok;
verify_type(map) -> ok;
verify_type(nonempty_list) -> ok;
verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok;
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index fbcd5de1bb..68d6105cfa 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -484,6 +484,15 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) ->
Other
end
end;
+check_liveness(R, [{test_heap,N,Live}|Is], St) ->
+ I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]},
+ check_liveness(R, [I|Is], St);
+check_liveness(R, [{allocate_zero,N,Live}|Is], St) ->
+ I = {block,[{set,[],[],{alloc,Live,{zero,N,0,[]}}}]},
+ check_liveness(R, [I|Is], St);
+check_liveness(R, [{get_list,S,D1,D2}|Is], St) ->
+ I = {block,[{set,[D1,D2],[S],get_list}]},
+ check_liveness(R, [I|Is], St);
check_liveness(_R, Is, St) when is_list(Is) ->
%% case Is of
%% [I|_] ->
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 6004f1974e..fd38fc0095 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -31,15 +31,6 @@
-import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]).
--define(MAXREG, 1024).
-
-%%-define(DEBUG, 1).
--ifdef(DEBUG).
--define(DBG_FORMAT(F, D), (io:format((F), (D)))).
--else.
--define(DBG_FORMAT(F, D), ok).
--endif.
-
%% To be called by the compiler.
module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts)
when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) ->
@@ -170,29 +161,18 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
% in the module (those that start with bs_start_match2).
}).
--ifdef(DEBUG).
-print_st(#st{x=Xs,y=Ys,numy=NumY,h=H,ct=Ct}) ->
- io:format(" #st{x=~p~n"
- " y=~p~n"
- " numy=~p,h=~p,ct=~w~n",
- [gb_trees:to_list(Xs),gb_trees:to_list(Ys),NumY,H,Ct]).
--endif.
-
validate_1(Is, Name, Arity, Entry, Ft) ->
validate_2(labels(Is), Name, Arity, Entry, Ft).
validate_2({Ls1,[{func_info,{atom,Mod},{atom,Name},Arity}=_F|Is]},
Name, Arity, Entry, Ft) ->
- lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls1),
- ?DBG_FORMAT(" ~p.~n", [_F]),
validate_3(labels(Is), Name, Arity, Entry, Mod, Ls1, Ft);
validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) ->
error({{'_',Name,Arity},{first(Is),length(Ls1),illegal_instruction}}).
validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) ->
- lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls2),
Offset = 1 + length(Ls1) + 1 + length(Ls2),
- EntryOK = (Entry =:= undefined) orelse lists:member(Entry, Ls2),
+ EntryOK = lists:member(Entry, Ls2),
if
EntryOK ->
St = init_state(Arity),
@@ -260,7 +240,6 @@ valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) ->
error({MFA,Error})
end;
valfun([I|Is], MFA, Offset, Vst0) ->
- ?DBG_FORMAT(" ~p.\n", [I]),
valfun(Is, MFA, Offset+1,
try
Vst = val_dsetel(I, Vst0),
@@ -278,7 +257,6 @@ valfun_1({label,Lbl}, #vst{current=St0,branched=B,labels=Lbls}=Vst) ->
valfun_1(_I, #vst{current=none}=Vst) ->
%% Ignore instructions after erlang:error/1,2, which
%% the original R10B compiler thought would return.
- ?DBG_FORMAT("Ignoring ~p\n", [_I]),
Vst;
valfun_1({badmatch,Src}, Vst) ->
assert_term(Src, Vst),
@@ -980,9 +958,9 @@ get_fls(#vst{current=#st{fls=Fls}}) when is_atom(Fls) -> Fls.
init_fregs() -> 0.
-set_freg({fr,Fr}, #vst{current=#st{f=Fregs0}=St}=Vst)
+set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst)
when is_integer(Fr), 0 =< Fr ->
- limit_check(Fr),
+ check_limit(Freg),
Bit = 1 bsl Fr,
if
Fregs0 band Bit =:= 0 ->
@@ -995,9 +973,10 @@ set_freg(Fr, _) -> error({bad_target,Fr}).
assert_freg_set({fr,Fr}=Freg, #vst{current=#st{f=Fregs}})
when is_integer(Fr), 0 =< Fr ->
if
- Fregs band (1 bsl Fr) =/= 0 ->
- limit_check(Fr);
- true -> error({uninitialized_reg,Freg})
+ (Fregs bsr Fr) band 1 =:= 0 ->
+ error({uninitialized_reg,Freg});
+ true ->
+ ok
end;
assert_freg_set(Fr, _) -> error({bad_source,Fr}).
@@ -1076,16 +1055,16 @@ set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst);
set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst);
set_type(_, _, #vst{}=Vst) -> Vst.
-set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst)
+set_type_reg(Type, {x,X}=Reg, #vst{current=#st{x=Xs}=St}=Vst)
when is_integer(X), 0 =< X ->
- limit_check(X),
+ check_limit(Reg),
Vst#vst{current=St#st{x=gb_trees:enter(X, Type, Xs)}};
set_type_reg(Type, Reg, Vst) ->
set_type_y(Type, Reg, Vst).
set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst)
when is_integer(Y), 0 =< Y ->
- limit_check(Y),
+ check_limit(Reg),
Ys = case gb_trees:lookup(Y, Ys0) of
none ->
error({invalid_store,Reg,Type});
@@ -1612,17 +1591,19 @@ return_type_math(pow, 2) -> {float,[]};
return_type_math(pi, 0) -> {float,[]};
return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
-limit_check(Num) when is_integer(Num), Num >= ?MAXREG ->
- error(limit);
-limit_check(_) -> ok.
+check_limit({x,X}) when is_integer(X), X < 1023 ->
+ %% Note: x(1023) is reserved for use by the BEAM loader.
+ ok;
+check_limit({y,Y}) when is_integer(Y), Y < 1024 ->
+ ok;
+check_limit({fr,Fr}) when is_integer(Fr), Fr < 1024 ->
+ ok;
+check_limit(_) ->
+ error(limit).
min(A, B) when is_integer(A), is_integer(B), A < B -> A;
min(A, B) when is_integer(A), is_integer(B) -> B.
gb_trees_from_list(L) -> gb_trees:from_orddict(lists:sort(L)).
--ifdef(DEBUG).
-error(Error) -> exit(Error).
--else.
error(Error) -> throw(Error).
--endif.
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index 58bb18e34a..b86be95cab 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -27,7 +27,7 @@
-module(cerl_trees).
-export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2,
- map/2, mapfold/3, size/1, variables/1]).
+ map/2, mapfold/3, mapfold/4, size/1, variables/1]).
-import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3,
ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4,
@@ -340,136 +340,162 @@ fold_pairs(_, S, []) ->
%% starting with the given value <code>Initial</code>, while doing a
%% post-order traversal of the tree, much like <code>fold/3</code>.
%%
+%% This is the same as mapfold/4, with an identity function as the
+%% pre-operation.
+%%
%% @see map/2
%% @see fold/3
+%% @see mapfold/4
-spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}),
term(), cerl:cerl()) -> {cerl:cerl(), term()}.
mapfold(F, S0, T) ->
+ mapfold(fun(T0, A) -> {T0, A} end, F, S0, T).
+
+
+%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) ->
+%% {cerl(), term()}
+%%
+%% Pre = Post = (cerl(), term()) -> {cerl(), term()}
+%%
+%% @doc Does a combined map/fold operation on the nodes of the
+%% tree. It begins by calling <code>Pre</code> on the tree, using the
+%% <code>Initial</code> value. It then deconstructs the top node of
+%% the returned tree and recurses on the children, using the returned
+%% value as the new initial and carrying the returned values from one
+%% call to the next. Finally it reassembles the top node from the
+%% children, calls <code>Post</code> on it and returns the result.
+
+-spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}),
+ fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}),
+ term(), cerl:cerl()) -> {cerl:cerl(), term()}.
+
+mapfold(Pre, Post, S00, T0) ->
+ {T, S0} = Pre(T0, S00),
case type(T) of
literal ->
case concrete(T) of
[_ | _] ->
- {T1, S1} = mapfold(F, S0, cons_hd(T)),
- {T2, S2} = mapfold(F, S1, cons_tl(T)),
- F(update_c_cons(T, T1, T2), S2);
+ {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)),
+ {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)),
+ Post(update_c_cons(T, T1, T2), S2);
V when tuple_size(V) > 0 ->
- {Ts, S1} = mapfold_list(F, S0, tuple_es(T)),
- F(update_c_tuple(T, Ts), S1);
+ {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)),
+ Post(update_c_tuple(T, Ts), S1);
_ ->
- F(T, S0)
+ Post(T, S0)
end;
var ->
- F(T, S0);
+ Post(T, S0);
values ->
- {Ts, S1} = mapfold_list(F, S0, values_es(T)),
- F(update_c_values(T, Ts), S1);
+ {Ts, S1} = mapfold_list(Pre, Post, S0, values_es(T)),
+ Post(update_c_values(T, Ts), S1);
cons ->
- {T1, S1} = mapfold(F, S0, cons_hd(T)),
- {T2, S2} = mapfold(F, S1, cons_tl(T)),
- F(update_c_cons_skel(T, T1, T2), S2);
+ {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)),
+ {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)),
+ Post(update_c_cons_skel(T, T1, T2), S2);
tuple ->
- {Ts, S1} = mapfold_list(F, S0, tuple_es(T)),
- F(update_c_tuple_skel(T, Ts), S1);
+ {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)),
+ Post(update_c_tuple_skel(T, Ts), S1);
map ->
- {M , S1} = mapfold(F, S0, map_arg(T)),
- {Ts, S2} = mapfold_list(F, S1, map_es(T)),
- F(update_c_map(T, M, Ts), S2);
+ {M , S1} = mapfold(Pre, Post, S0, map_arg(T)),
+ {Ts, S2} = mapfold_list(Pre, Post, S1, map_es(T)),
+ Post(update_c_map(T, M, Ts), S2);
map_pair ->
- {Op, S1} = mapfold(F, S0, map_pair_op(T)),
- {Key, S2} = mapfold(F, S1, map_pair_key(T)),
- {Val, S3} = mapfold(F, S2, map_pair_val(T)),
- F(update_c_map_pair(T,Op,Key,Val), S3);
+ {Op, S1} = mapfold(Pre, Post, S0, map_pair_op(T)),
+ {Key, S2} = mapfold(Pre, Post, S1, map_pair_key(T)),
+ {Val, S3} = mapfold(Pre, Post, S2, map_pair_val(T)),
+ Post(update_c_map_pair(T,Op,Key,Val), S3);
'let' ->
- {Vs, S1} = mapfold_list(F, S0, let_vars(T)),
- {A, S2} = mapfold(F, S1, let_arg(T)),
- {B, S3} = mapfold(F, S2, let_body(T)),
- F(update_c_let(T, Vs, A, B), S3);
+ {Vs, S1} = mapfold_list(Pre, Post, S0, let_vars(T)),
+ {A, S2} = mapfold(Pre, Post, S1, let_arg(T)),
+ {B, S3} = mapfold(Pre, Post, S2, let_body(T)),
+ Post(update_c_let(T, Vs, A, B), S3);
seq ->
- {A, S1} = mapfold(F, S0, seq_arg(T)),
- {B, S2} = mapfold(F, S1, seq_body(T)),
- F(update_c_seq(T, A, B), S2);
+ {A, S1} = mapfold(Pre, Post, S0, seq_arg(T)),
+ {B, S2} = mapfold(Pre, Post, S1, seq_body(T)),
+ Post(update_c_seq(T, A, B), S2);
apply ->
- {E, S1} = mapfold(F, S0, apply_op(T)),
- {As, S2} = mapfold_list(F, S1, apply_args(T)),
- F(update_c_apply(T, E, As), S2);
+ {E, S1} = mapfold(Pre, Post, S0, apply_op(T)),
+ {As, S2} = mapfold_list(Pre, Post, S1, apply_args(T)),
+ Post(update_c_apply(T, E, As), S2);
call ->
- {M, S1} = mapfold(F, S0, call_module(T)),
- {N, S2} = mapfold(F, S1, call_name(T)),
- {As, S3} = mapfold_list(F, S2, call_args(T)),
- F(update_c_call(T, M, N, As), S3);
+ {M, S1} = mapfold(Pre, Post, S0, call_module(T)),
+ {N, S2} = mapfold(Pre, Post, S1, call_name(T)),
+ {As, S3} = mapfold_list(Pre, Post, S2, call_args(T)),
+ Post(update_c_call(T, M, N, As), S3);
primop ->
- {N, S1} = mapfold(F, S0, primop_name(T)),
- {As, S2} = mapfold_list(F, S1, primop_args(T)),
- F(update_c_primop(T, N, As), S2);
+ {N, S1} = mapfold(Pre, Post, S0, primop_name(T)),
+ {As, S2} = mapfold_list(Pre, Post, S1, primop_args(T)),
+ Post(update_c_primop(T, N, As), S2);
'case' ->
- {A, S1} = mapfold(F, S0, case_arg(T)),
- {Cs, S2} = mapfold_list(F, S1, case_clauses(T)),
- F(update_c_case(T, A, Cs), S2);
+ {A, S1} = mapfold(Pre, Post, S0, case_arg(T)),
+ {Cs, S2} = mapfold_list(Pre, Post, S1, case_clauses(T)),
+ Post(update_c_case(T, A, Cs), S2);
clause ->
- {Ps, S1} = mapfold_list(F, S0, clause_pats(T)),
- {G, S2} = mapfold(F, S1, clause_guard(T)),
- {B, S3} = mapfold(F, S2, clause_body(T)),
- F(update_c_clause(T, Ps, G, B), S3);
+ {Ps, S1} = mapfold_list(Pre, Post, S0, clause_pats(T)),
+ {G, S2} = mapfold(Pre, Post, S1, clause_guard(T)),
+ {B, S3} = mapfold(Pre, Post, S2, clause_body(T)),
+ Post(update_c_clause(T, Ps, G, B), S3);
alias ->
- {V, S1} = mapfold(F, S0, alias_var(T)),
- {P, S2} = mapfold(F, S1, alias_pat(T)),
- F(update_c_alias(T, V, P), S2);
+ {V, S1} = mapfold(Pre, Post, S0, alias_var(T)),
+ {P, S2} = mapfold(Pre, Post, S1, alias_pat(T)),
+ Post(update_c_alias(T, V, P), S2);
'fun' ->
- {Vs, S1} = mapfold_list(F, S0, fun_vars(T)),
- {B, S2} = mapfold(F, S1, fun_body(T)),
- F(update_c_fun(T, Vs, B), S2);
+ {Vs, S1} = mapfold_list(Pre, Post, S0, fun_vars(T)),
+ {B, S2} = mapfold(Pre, Post, S1, fun_body(T)),
+ Post(update_c_fun(T, Vs, B), S2);
'receive' ->
- {Cs, S1} = mapfold_list(F, S0, receive_clauses(T)),
- {E, S2} = mapfold(F, S1, receive_timeout(T)),
- {A, S3} = mapfold(F, S2, receive_action(T)),
- F(update_c_receive(T, Cs, E, A), S3);
+ {Cs, S1} = mapfold_list(Pre, Post, S0, receive_clauses(T)),
+ {E, S2} = mapfold(Pre, Post, S1, receive_timeout(T)),
+ {A, S3} = mapfold(Pre, Post, S2, receive_action(T)),
+ Post(update_c_receive(T, Cs, E, A), S3);
'try' ->
- {E, S1} = mapfold(F, S0, try_arg(T)),
- {Vs, S2} = mapfold_list(F, S1, try_vars(T)),
- {B, S3} = mapfold(F, S2, try_body(T)),
- {Evs, S4} = mapfold_list(F, S3, try_evars(T)),
- {H, S5} = mapfold(F, S4, try_handler(T)),
- F(update_c_try(T, E, Vs, B, Evs, H), S5);
+ {E, S1} = mapfold(Pre, Post, S0, try_arg(T)),
+ {Vs, S2} = mapfold_list(Pre, Post, S1, try_vars(T)),
+ {B, S3} = mapfold(Pre, Post, S2, try_body(T)),
+ {Evs, S4} = mapfold_list(Pre, Post, S3, try_evars(T)),
+ {H, S5} = mapfold(Pre, Post, S4, try_handler(T)),
+ Post(update_c_try(T, E, Vs, B, Evs, H), S5);
'catch' ->
- {B, S1} = mapfold(F, S0, catch_body(T)),
- F(update_c_catch(T, B), S1);
+ {B, S1} = mapfold(Pre, Post, S0, catch_body(T)),
+ Post(update_c_catch(T, B), S1);
binary ->
- {Ds, S1} = mapfold_list(F, S0, binary_segments(T)),
- F(update_c_binary(T, Ds), S1);
+ {Ds, S1} = mapfold_list(Pre, Post, S0, binary_segments(T)),
+ Post(update_c_binary(T, Ds), S1);
bitstr ->
- {Val, S1} = mapfold(F, S0, bitstr_val(T)),
- {Size, S2} = mapfold(F, S1, bitstr_size(T)),
- {Unit, S3} = mapfold(F, S2, bitstr_unit(T)),
- {Type, S4} = mapfold(F, S3, bitstr_type(T)),
- {Flags, S5} = mapfold(F, S4, bitstr_flags(T)),
- F(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5);
+ {Val, S1} = mapfold(Pre, Post, S0, bitstr_val(T)),
+ {Size, S2} = mapfold(Pre, Post, S1, bitstr_size(T)),
+ {Unit, S3} = mapfold(Pre, Post, S2, bitstr_unit(T)),
+ {Type, S4} = mapfold(Pre, Post, S3, bitstr_type(T)),
+ {Flags, S5} = mapfold(Pre, Post, S4, bitstr_flags(T)),
+ Post(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5);
letrec ->
- {Ds, S1} = mapfold_pairs(F, S0, letrec_defs(T)),
- {B, S2} = mapfold(F, S1, letrec_body(T)),
- F(update_c_letrec(T, Ds, B), S2);
+ {Ds, S1} = mapfold_pairs(Pre, Post, S0, letrec_defs(T)),
+ {B, S2} = mapfold(Pre, Post, S1, letrec_body(T)),
+ Post(update_c_letrec(T, Ds, B), S2);
module ->
- {N, S1} = mapfold(F, S0, module_name(T)),
- {Es, S2} = mapfold_list(F, S1, module_exports(T)),
- {As, S3} = mapfold_pairs(F, S2, module_attrs(T)),
- {Ds, S4} = mapfold_pairs(F, S3, module_defs(T)),
- F(update_c_module(T, N, Es, As, Ds), S4)
+ {N, S1} = mapfold(Pre, Post, S0, module_name(T)),
+ {Es, S2} = mapfold_list(Pre, Post, S1, module_exports(T)),
+ {As, S3} = mapfold_pairs(Pre, Post, S2, module_attrs(T)),
+ {Ds, S4} = mapfold_pairs(Pre, Post, S3, module_defs(T)),
+ Post(update_c_module(T, N, Es, As, Ds), S4)
end.
-mapfold_list(F, S0, [T | Ts]) ->
- {T1, S1} = mapfold(F, S0, T),
- {Ts1, S2} = mapfold_list(F, S1, Ts),
+mapfold_list(Pre, Post, S0, [T | Ts]) ->
+ {T1, S1} = mapfold(Pre, Post, S0, T),
+ {Ts1, S2} = mapfold_list(Pre, Post, S1, Ts),
{[T1 | Ts1], S2};
-mapfold_list(_, S, []) ->
+mapfold_list(_, _, S, []) ->
{[], S}.
-mapfold_pairs(F, S0, [{T1, T2} | Ps]) ->
- {T3, S1} = mapfold(F, S0, T1),
- {T4, S2} = mapfold(F, S1, T2),
- {Ps1, S3} = mapfold_pairs(F, S2, Ps),
+mapfold_pairs(Pre, Post, S0, [{T1, T2} | Ps]) ->
+ {T3, S1} = mapfold(Pre, Post, S0, T1),
+ {T4, S2} = mapfold(Pre, Post, S1, T2),
+ {Ps1, S3} = mapfold_pairs(Pre, Post, S2, Ps),
{[{T3, T4} | Ps1], S3};
-mapfold_pairs(_, S, []) ->
+mapfold_pairs(_, _, S, []) ->
{[], S}.
@@ -640,8 +666,8 @@ vars_in_list([], _, A) ->
vars_in_defs(Ds, S) ->
vars_in_defs(Ds, S, []).
-vars_in_defs([{_, F} | Ds], S, A) ->
- vars_in_defs(Ds, S, ordsets:union(variables(F, S), A));
+vars_in_defs([{_, Post} | Ds], S, A) ->
+ vars_in_defs(Ds, S, ordsets:union(variables(Post, S), A));
vars_in_defs([], _, A) ->
A.
@@ -703,13 +729,14 @@ label(T, N, Env) ->
%% Constant literals are not labeled.
{T, N};
var ->
- case dict:find(var_name(T), Env) of
- {ok, L} ->
- {As, _} = label_ann(T, L),
- N1 = N;
- error ->
- {As, N1} = label_ann(T, N)
- end,
+ {As, N1} =
+ case dict:find(var_name(T), Env) of
+ {ok, L} ->
+ {A, _} = label_ann(T, L),
+ {A, N};
+ error ->
+ label_ann(T, N)
+ end,
{set_ann(T, As), N1};
values ->
{Ts, N1} = label_list(values_es(T), N, Env),
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index e0a29fe9b1..46917905de 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -40,6 +40,8 @@
%%----------------------------------------------------------------------
+-type abstract_code() :: [erl_parse:abstract_form()].
+
-type option() :: atom() | {atom(), term()} | {'d', atom(), term()}.
-type err_info() :: {erl_anno:line() | 'none',
@@ -48,6 +50,9 @@
-type warnings() :: [{file:filename(), [err_info()]}].
-type mod_ret() :: {'ok', module()}
| {'ok', module(), cerl:c_module()} %% with option 'to_core'
+ | {'ok', %% with option 'to_pp'
+ module() | [], %% module() if 'to_exp'
+ abstract_code()}
| {'ok', module(), warnings()}.
-type bin_ret() :: {'ok', module(), binary()}
| {'ok', module(), binary(), warnings()}.
@@ -78,7 +83,11 @@ file(File, Opts) when is_list(Opts) ->
file(File, Opt) ->
file(File, [Opt|?DEFAULT_OPTIONS]).
-forms(File) -> forms(File, ?DEFAULT_OPTIONS).
+-spec forms(abstract_code()) -> comp_ret().
+
+forms(Forms) -> forms(Forms, ?DEFAULT_OPTIONS).
+
+-spec forms(abstract_code(), [option()] | option()) -> comp_ret().
forms(Forms, Opts) when is_list(Opts) ->
do_compile({forms,Forms}, [binary|Opts++env_default_opts()]);
@@ -106,6 +115,8 @@ noenv_file(File, Opts) when is_list(Opts) ->
noenv_file(File, Opt) ->
noenv_file(File, [Opt|?DEFAULT_OPTIONS]).
+-spec noenv_forms(abstract_code(), [option()] | option()) -> comp_ret().
+
noenv_forms(Forms, Opts) when is_list(Opts) ->
do_compile({forms,Forms}, [binary|Opts]);
noenv_forms(Forms, Opt) when is_atom(Opt) ->
@@ -671,11 +682,16 @@ asm_passes() ->
%% Assembly level optimisations.
[{delay,
[{pass,beam_a},
+ {iff,da,{listing,"a"}},
{unless,no_postopt,
- [{pass,beam_block},
+ [{unless,no_reorder,{pass,beam_reorder}},
+ {iff,dre,{listing,"reorder"}},
+ {pass,beam_block},
{iff,dblk,{listing,"block"}},
{unless,no_except,{pass,beam_except}},
{iff,dexcept,{listing,"except"}},
+ {unless,no_bs_opt,{pass,beam_bs}},
+ {iff,dbs,{listing,"bs"}},
{unless,no_bopt,{pass,beam_bool}},
{iff,dbool,{listing,"bool"}},
{unless,no_topt,{pass,beam_type}},
@@ -703,6 +719,7 @@ asm_passes() ->
{iff,no_postopt,[{pass,beam_clean}]},
{pass,beam_z},
+ {iff,dz,{listing,"z"}},
{iff,dopt,{listing,"optimize"}},
{iff,'S',{listing,"S"}},
{iff,'to_asm',{done,"S"}}]},
@@ -1300,21 +1317,12 @@ generate_key(String) when is_list(String) ->
encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) ->
Bin1 = case byte_size(Bin0) rem BlockSize of
0 -> Bin0;
- N -> list_to_binary([Bin0,random_bytes(BlockSize-N)])
+ N -> list_to_binary([Bin0,crypto:rand_bytes(BlockSize-N)])
end,
Bin = crypto:block_encrypt(Type, Key, IVec, Bin1),
TypeString = atom_to_list(Type),
list_to_binary([0,length(TypeString),TypeString,Bin]).
-random_bytes(N) ->
- _ = random:seed(erlang:time_offset(),
- erlang:monotonic_time(),
- erlang:unique_integer()),
- random_bytes_1(N, []).
-
-random_bytes_1(0, Acc) -> Acc;
-random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]).
-
save_core_code(St) ->
{ok,St#compile{core_code=cerl:from_records(St#compile.code)}}.
@@ -1612,11 +1620,8 @@ output_encoding(F, #compile{encoding = Encoding}) ->
ok = io:setopts(F, [{encoding, Encoding}]),
ok = io:fwrite(F, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]).
-restore_expanded_types("P", Fs) ->
- epp:restore_typed_record_fields(Fs);
restore_expanded_types("E", {M,I,Fs0}) ->
- Fs1 = restore_expand_module(Fs0),
- Fs = epp:restore_typed_record_fields(Fs1),
+ Fs = restore_expand_module(Fs0),
{M,I,Fs};
restore_expanded_types(_Ext, Code) -> Code.
@@ -1628,6 +1633,8 @@ restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) ->
[{attribute,Line,spec,Arg}|restore_expand_module(Fs)];
restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) ->
[{attribute,Line,callback,Arg}|restore_expand_module(Fs)];
+restore_expand_module([{attribute,Line,record,[R]}|Fs]) ->
+ [{attribute,Line,record,R}|restore_expand_module(Fs)];
restore_expand_module([F|Fs]) ->
[F|restore_expand_module(Fs)];
restore_expand_module([]) -> [].
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index afb85f4710..a2b2a1d277 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -25,6 +25,7 @@
beam_asm,
beam_block,
beam_bool,
+ beam_bs,
beam_bsm,
beam_clean,
beam_dead,
@@ -37,6 +38,7 @@
beam_opcodes,
beam_peep,
beam_receive,
+ beam_reorder,
beam_split,
beam_trim,
beam_type,
diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl
index 3abb520485..839c736ff2 100644
--- a/lib/compiler/src/core_lib.erl
+++ b/lib/compiler/src/core_lib.erl
@@ -21,52 +21,16 @@
-module(core_lib).
--deprecated({get_anno,1,next_major_release}).
--deprecated({set_anno,2,next_major_release}).
--deprecated({is_literal,1,next_major_release}).
--deprecated({is_literal_list,1,next_major_release}).
--deprecated({literal_value,1,next_major_release}).
-
--export([get_anno/1,set_anno/2]).
--export([is_literal/1,is_literal_list/1]).
--export([literal_value/1]).
-export([make_values/1]).
-export([is_var_used/2]).
-include("core_parse.hrl").
-%%
-%% Generic get/set annotation that should be used only with cerl() structures.
-%%
--spec get_anno(cerl:cerl()) -> term().
-
-get_anno(C) -> cerl:get_ann(C).
-
--spec set_anno(cerl:cerl(), term()) -> cerl:cerl().
-
-set_anno(C, A) -> cerl:set_ann(C, A).
-
--spec is_literal(cerl:cerl()) -> boolean().
-
-is_literal(Cerl) ->
- cerl:is_literal(cerl:fold_literal(Cerl)).
-
--spec is_literal_list([cerl:cerl()]) -> boolean().
-
-is_literal_list(Es) -> lists:all(fun is_literal/1, Es).
-
-%% Return the value of LitExpr.
--spec literal_value(cerl:c_literal() | cerl:c_binary() |
- cerl:c_map() | cerl:c_cons() | cerl:c_tuple()) -> term().
-
-literal_value(Cerl) ->
- cerl:concrete(cerl:fold_literal(Cerl)).
-
%% Make a suitable values structure, expr or values, depending on Expr.
-spec make_values([cerl:cerl()] | cerl:cerl()) -> cerl:cerl().
make_values([E]) -> E;
-make_values([H|_]=Es) -> #c_values{anno=get_anno(H),es=Es};
+make_values([H|_]=Es) -> #c_values{anno=cerl:get_ann(H),es=Es};
make_values([]) -> #c_values{es=[]};
make_values(E) -> E.
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index cc54f6e411..7d3513c0ba 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1999-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.
@@ -73,7 +73,7 @@
%% Define the lint state record.
-record(lint, {module :: module(), % Current module
- func :: fa(), % Current function
+ func :: fa() | 'undefined', % Current function
errors = [] :: [error()], % Errors
warnings= [] :: [warning()]}). % Warnings
diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl
index 0e9e12d1ad..5a4a870769 100644
--- a/lib/compiler/src/rec_env.erl
+++ b/lib/compiler/src/rec_env.erl
@@ -598,7 +598,16 @@ start_range(Env) ->
%% (pseudo-)randomly distributed over the range.
generate(_N, Range) ->
- random:uniform(Range). % works well
+ %% We must use the same sequence of random variables to ensure
+ %% that two compilations of the same source code generates the
+ %% same BEAM code.
+ case rand:export_seed() of
+ undefined ->
+ rand:seed(exsplus, {1,42,2053});
+ _ ->
+ ok
+ end,
+ rand:uniform(Range). % works well
%% =====================================================================
diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl
index ac32db10fe..c6cfdbae7e 100644
--- a/lib/compiler/src/sys_core_dsetel.erl
+++ b/lib/compiler/src/sys_core_dsetel.erl
@@ -72,7 +72,7 @@ module(M0, _Options) ->
{ok,M}.
visit_module(#c_module{defs=Ds0}=R) ->
- Env = dict:new(),
+ Env = #{},
Ds = visit_module_1(Ds0, Env, []),
R#c_module{defs=Ds}.
@@ -95,9 +95,11 @@ visit(Env, #c_var{name={_,_}}=R) ->
{R, Env};
visit(Env0, #c_var{name=X}=R) ->
%% There should not be any free variables. If there are,
- %% the next line will cause an exception.
- {ok, N} = dict:find(X, Env0),
- {R, dict:store(X, N+1, Env0)};
+ %% the case will fail with an exception.
+ case Env0 of
+ #{X:=N} ->
+ {R, Env0#{X:=N+1}}
+ end;
visit(Env, #c_literal{}=R) ->
{R, Env};
visit(Env0, #c_tuple{es=Es0}=R) ->
@@ -203,7 +205,7 @@ bind_vars(Vs, Env) ->
bind_vars(Vs, Env, []).
bind_vars([#c_var{name=X}|Vs], Env0, Xs)->
- bind_vars(Vs, dict:store(X, 0, Env0), [X|Xs]);
+ bind_vars(Vs, Env0#{X=>0}, [X|Xs]);
bind_vars([], Env,Xs) ->
{Xs, Env}.
@@ -217,7 +219,7 @@ visit_pats([], Env, Vs) ->
{Vs, Env}.
visit_pat(Env0, #c_var{name=V}, Vs) ->
- {[V|Vs], dict:store(V, 0, Env0)};
+ {[V|Vs], Env0#{V=>0}};
visit_pat(Env0, #c_tuple{es=Es}, Vs) ->
visit_pats(Es, Env0, Vs);
visit_pat(Env0, #c_map{es=Es}, Vs) ->
@@ -235,23 +237,25 @@ visit_pat(Env0, #c_bitstr{val=Val,size=Sz}, Vs0) ->
case Sz of
#c_var{name=V} ->
%% We don't tolerate free variables.
- {ok, N} = dict:find(V, Env0),
- {Vs0, dict:store(V, N+1, Env0)};
+ case Env0 of
+ #{V:=N} ->
+ {Vs0, Env0#{V:=N+1}}
+ end;
_ ->
visit_pat(Env0, Sz, Vs0)
end,
visit_pat(Env1, Val, Vs1);
visit_pat(Env0, #c_alias{pat=P,var=#c_var{name=V}}, Vs) ->
- visit_pat(dict:store(V, 0, Env0), P, [V|Vs]);
+ visit_pat(Env0#{V=>0}, P, [V|Vs]);
visit_pat(Env, #c_literal{}, Vs) ->
{Vs, Env}.
restore_vars([V|Vs], Env0, Env1) ->
- case dict:find(V, Env0) of
- {ok, N} ->
- restore_vars(Vs, Env0, dict:store(V, N, Env1));
- error ->
- restore_vars(Vs, Env0, dict:erase(V, Env1))
+ case Env0 of
+ #{V:=N} ->
+ restore_vars(Vs, Env0, Env1#{V=>N});
+ _ ->
+ restore_vars(Vs, Env0, maps:remove(V, Env1))
end;
restore_vars([], _, Env1) ->
Env1.
@@ -349,8 +353,8 @@ is_safe(#c_literal{}) -> true;
is_safe(_) -> false.
is_single_use(V, Env) ->
- case dict:find(V, Env) of
- {ok, 1} ->
+ case Env of
+ #{V:=1} ->
true;
_ ->
false
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 65699ccda9..43ce9a7172 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -2793,12 +2793,18 @@ extract_type_1(Expr, Sub) ->
true -> bool
end.
+returns_integer('band', [_,_]) -> true;
+returns_integer('bnot', [_]) -> true;
+returns_integer('bor', [_,_]) -> true;
+returns_integer('bxor', [_,_]) -> true;
returns_integer(bit_size, [_]) -> true;
returns_integer('bsl', [_,_]) -> true;
returns_integer('bsr', [_,_]) -> true;
returns_integer(byte_size, [_]) -> true;
+returns_integer('div', [_,_]) -> true;
returns_integer(length, [_]) -> true;
returns_integer('rem', [_,_]) -> true;
+returns_integer('round', [_]) -> true;
returns_integer(size, [_]) -> true;
returns_integer(tuple_size, [_]) -> true;
returns_integer(trunc, [_]) -> true;
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index d9cc4b530c..7ab4e1845c 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -29,30 +29,26 @@
%% Main entry point.
-export([module/2]).
--import(ordsets, [from_list/1,union/2]).
-import(lists, [member/2,foldl/3,foldr/3]).
--include("../include/erl_bits.hrl").
-
-type fa() :: {atom(), arity()}.
-record(expand, {module=[], %Module name
exports=[], %Exports
- imports=[], %Imports
attributes=[], %Attributes
callbacks=[], %Callbacks
optional_callbacks=[] :: [fa()], %Optional callbacks
- defined, %Defined functions (gb_set)
vcount=0, %Variable counter
func=[], %Current function
arity=[], %Arity for current function
- fcount=0 %Local fun count
+ fcount=0, %Local fun count
+ ctype %Call type map
}).
%% module(Forms, CompileOptions)
%% {ModuleName,Exports,TransformedForms,CompileOptions'}
-%% Expand the forms in one module. N.B.: the lists of predefined
-%% exports and imports are really ordsets!
+%% Expand the forms in one module.
+%%
%% CompileOptions is augmented with options from -compile attributes.
module(Fs0, Opts0) ->
@@ -65,19 +61,28 @@ module(Fs0, Opts0) ->
%% Set pre-defined exported functions.
PreExp = [{module_info,0},{module_info,1}],
+ %% Build the set of defined functions and the initial call
+ %% type map.
+ Defined = defined_functions(Fs, PreExp),
+ Ctype = maps:from_list([{K,local} || K <- Defined]),
+
%% Build initial expand record.
St0 = #expand{exports=PreExp,
- defined=PreExp
+ ctype=Ctype
},
+
%% Expand the functions.
- {Tfs,St1} = forms(Fs, define_functions(Fs, St0)),
+ {Tfs,St1} = forms(Fs, St0),
+
%% Get the correct list of exported functions.
Exports = case member(export_all, Opts) of
- true -> gb_sets:to_list(St1#expand.defined);
+ true -> Defined;
false -> St1#expand.exports
end,
+ St2 = St1#expand{exports=Exports,ctype=undefined},
+
%% Generate all functions from stored info.
- {Ats,St3} = module_attrs(St1#expand{exports = Exports}),
+ {Ats,St3} = module_attrs(St2),
{Mfs,St4} = module_predef_funcs(St3),
{St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs,
Opts}.
@@ -85,14 +90,14 @@ module(Fs0, Opts0) ->
compiler_options(Forms) ->
lists:flatten([C || {attribute,_,compile,C} <- Forms]).
-%% define_function(Form, State) -> State.
+%% defined_function(Forms, Predef) -> Functions.
%% Add function to defined if form is a function.
-define_functions(Forms, #expand{defined=Predef}=St) ->
+defined_functions(Forms, Predef) ->
Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc];
(_, Acc) -> Acc
end, Predef, Forms),
- St#expand{defined=gb_sets:from_list(Fs)}.
+ ordsets:from_list(Fs).
module_attrs(#expand{attributes=Attributes}=St) ->
Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
@@ -113,23 +118,21 @@ is_fa_list([{FuncName, Arity}|L])
is_fa_list([]) -> true;
is_fa_list(_) -> false.
-module_predef_funcs(St) ->
- {Mpf1,St1}=module_predef_func_beh_info(St),
- {Mpf2,St2}=module_predef_funcs_mod_info(St1),
+module_predef_funcs(St0) ->
+ {Mpf1,St1} = module_predef_func_beh_info(St0),
+ Mpf2 = module_predef_funcs_mod_info(St1),
Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2],
- {Mpf,St2}.
+ {Mpf,St1}.
module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
{[], St};
module_predef_func_beh_info(#expand{callbacks=Callbacks,
optional_callbacks=OptionalCallbacks,
- defined=Defined,
exports=Exports}=St) ->
- PreDef=[{behaviour_info,1}],
- PreExp=PreDef,
+ PreDef0 = [{behaviour_info,1}],
+ PreDef = ordsets:from_list(PreDef0),
{[gen_beh_info(Callbacks, OptionalCallbacks)],
- St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined),
- exports=union(from_list(PreExp), Exports)}}.
+ St#expand{exports=ordsets:union(PreDef, Exports)}}.
gen_beh_info(Callbacks, OptionalCallbacks) ->
List = make_list(Callbacks),
@@ -156,20 +159,16 @@ make_optional_list([{Name,Arity}|Rest]) ->
{integer,0,Arity}]},
make_optional_list(Rest)}.
-module_predef_funcs_mod_info(St) ->
- PreDef = [{module_info,0},{module_info,1}],
- PreExp = PreDef,
- {[{function,0,module_info,0,
- [{clause,0,[],[],
+module_predef_funcs_mod_info(#expand{module=Mod}) ->
+ ModAtom = {atom,0,Mod},
+ [{function,0,module_info,0,
+ [{clause,0,[],[],
[{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
- [{atom,0,St#expand.module}]}]}]},
- {function,0,module_info,1,
- [{clause,0,[{var,0,'X'}],[],
+ [ModAtom]}]}]},
+ {function,0,module_info,1,
+ [{clause,0,[{var,0,'X'}],[],
[{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
- [{atom,0,St#expand.module},{var,0,'X'}]}]}]}],
- St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef),
- St#expand.defined),
- exports=union(from_list(PreExp), St#expand.exports)}}.
+ [ModAtom,{var,0,'X'}]}]}]}].
%% forms(Forms, State) ->
%% {TransformedForms,State'}
@@ -196,7 +195,8 @@ attribute(module, Module, _L, St) ->
true = is_atom(Module),
St#expand{module=Module};
attribute(export, Es, _L, St) ->
- St#expand{exports=union(from_list(Es), St#expand.exports)};
+ St#expand{exports=ordsets:union(ordsets:from_list(Es),
+ St#expand.exports)};
attribute(import, Is, _L, St) ->
import(Is, St);
attribute(compile, _C, _L, St) ->
@@ -231,8 +231,6 @@ head(As, St) -> pattern_list(As, St).
%% {TransformedPattern,State'}
%%
-pattern({var,_,'_'}=Var, St) -> %Ignore anonymous variable.
- {Var,St};
pattern({var,_,_}=Var, St) ->
{Var,St};
pattern({char,_,_}=Char, St) ->
@@ -385,19 +383,19 @@ expr({block,Line,Es0}, St0) ->
{Es,St1} = exprs(Es0, St0),
{{block,Line,Es},St1};
expr({'if',Line,Cs0}, St0) ->
- {Cs,St1} = icr_clauses(Cs0, St0),
+ {Cs,St1} = clauses(Cs0, St0),
{{'if',Line,Cs},St1};
expr({'case',Line,E0,Cs0}, St0) ->
{E,St1} = expr(E0, St0),
- {Cs,St2} = icr_clauses(Cs0, St1),
+ {Cs,St2} = clauses(Cs0, St1),
{{'case',Line,E,Cs},St2};
expr({'receive',Line,Cs0}, St0) ->
- {Cs,St1} = icr_clauses(Cs0, St0),
+ {Cs,St1} = clauses(Cs0, St0),
{{'receive',Line,Cs},St1};
expr({'receive',Line,Cs0,To0,ToEs0}, St0) ->
{To,St1} = expr(To0, St0),
{ToEs,St2} = exprs(ToEs0, St1),
- {Cs,St3} = icr_clauses(Cs0, St2),
+ {Cs,St3} = clauses(Cs0, St2),
{{'receive',Line,Cs,To,ToEs},St3};
expr({'fun',Line,Body}, St) ->
fun_tq(Line, Body, St);
@@ -406,21 +404,15 @@ expr({named_fun,Line,Name,Cs}, St) ->
expr({call,Line,{atom,La,N}=Atom,As0}, St0) ->
{As,St1} = expr_list(As0, St0),
Ar = length(As),
- case defined(N,Ar,St1) of
- true ->
+ Key = {N,Ar},
+ case St1#expand.ctype of
+ #{Key:=local} ->
{{call,Line,Atom,As},St1};
+ #{Key:={imported,Mod}} ->
+ {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
_ ->
- case imported(N, Ar, St1) of
- {yes,Mod} ->
- {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
- no ->
- case erl_internal:bif(N, Ar) of
- true ->
- {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1};
- false -> %% This should have been handled by erl_lint
- {{call,Line,Atom,As},St1}
- end
- end
+ true = erl_internal:bif(N, Ar),
+ {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1}
end;
expr({call,Line,{remote,Lr,M0,F},As0}, St0) ->
{[M1,F1|As1],St1} = expr_list([M0,F|As0], St0),
@@ -430,12 +422,11 @@ expr({call,Line,F,As0}, St0) ->
{{call,Line,Fun1,As1},St1};
expr({'try',Line,Es0,Scs0,Ccs0,As0}, St0) ->
{Es1,St1} = exprs(Es0, St0),
- {Scs1,St2} = icr_clauses(Scs0, St1),
- {Ccs1,St3} = icr_clauses(Ccs0, St2),
+ {Scs1,St2} = clauses(Scs0, St1),
+ {Ccs1,St3} = clauses(Ccs0, St2),
{As1,St4} = exprs(As0, St3),
{{'try',Line,Es1,Scs1,Ccs1,As1},St4};
expr({'catch',Line,E0}, St0) ->
- %% Catch exports no new variables.
{E,St1} = expr(E0, St0),
{{'catch',Line,E},St1};
expr({match,Line,P0,E0}, St0) ->
@@ -456,21 +447,6 @@ expr_list([E0|Es0], St0) ->
{[E|Es],St2};
expr_list([], St) -> {[],St}.
-%% icr_clauses([Clause], State) -> {[TransformedClause],State'}
-%% Be very careful here to return the variables that are really used
-%% and really new.
-
-icr_clauses([], St) -> {[],St};
-icr_clauses(Clauses, St) -> icr_clauses2(Clauses, St).
-
-icr_clauses2([{clause,Line,H0,G0,B0}|Cs0], St0) ->
- {H,St1} = head(H0, St0),
- {G,St2} = guard(G0, St1),
- {B,St3} = exprs(B0, St2),
- {Cs,St4} = icr_clauses2(Cs0, St3),
- {[{clause,Line,H,G,B}|Cs],St4};
-icr_clauses2([], St) -> {[],St}.
-
%% lc_tq(Line, Qualifiers, State) ->
%% {[TransQual],State'}
@@ -486,16 +462,9 @@ lc_tq(Line, [{b_generate,Lg,P0,G0}|Qs0], St0) ->
{Qs1,St3} = lc_tq(Line, Qs0, St2),
{[{b_generate,Lg,P1,G1}|Qs1],St3};
lc_tq(Line, [F0 | Qs0], St0) ->
- case erl_lint:is_guard_test(F0) of
- true ->
- {F1,St1} = guard_test(F0, St0),
- {Qs1,St2} = lc_tq(Line, Qs0, St1),
- {[F1|Qs1],St2};
- false ->
- {F1,St1} = expr(F0, St0),
- {Qs1,St2} = lc_tq(Line, Qs0, St1),
- {[F1 | Qs1],St2}
- end;
+ {F1,St1} = expr(F0, St0),
+ {Qs1,St2} = lc_tq(Line, Qs0, St1),
+ {[F1|Qs1],St2};
lc_tq(_Line, [], St0) ->
{[],St0}.
@@ -527,7 +496,7 @@ fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) ->
fun_tq(Lf, {function,_,_,_}=ExtFun, St) ->
{{'fun',Lf,ExtFun},St};
fun_tq(Lf, {clauses,Cs0}, St0) ->
- {Cs1,St1} = fun_clauses(Cs0, St0),
+ {Cs1,St1} = clauses(Cs0, St0),
{Fname,St2} = new_fun_name(St1),
%% Set dummy values for Index and Uniq -- the real values will
%% be assigned by beam_asm.
@@ -535,18 +504,10 @@ fun_tq(Lf, {clauses,Cs0}, St0) ->
{{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}.
fun_tq(Line, Cs0, St0, Name) ->
- {Cs1,St1} = fun_clauses(Cs0, St0),
+ {Cs1,St1} = clauses(Cs0, St0),
{Fname,St2} = new_fun_name(St1, Name),
{{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}.
-fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) ->
- {H,St1} = head(H0, St0),
- {G,St2} = guard(G0, St1),
- {B,St3} = exprs(B0, St2),
- {Cs,St4} = fun_clauses(Cs0, St3),
- {[{clause,L,H,G,B}|Cs],St4};
-fun_clauses([], St) -> {[],St}.
-
%% new_fun_name(State) -> {FunName,State}.
new_fun_name(St) ->
@@ -571,7 +532,6 @@ pattern_element({bin_element,Line,Expr0,Size0,Type0}, {Es,St0}) ->
{[{bin_element,Line,Expr,Size,Type}|Es],St2}.
pat_bit_size(default, St) -> {default,St};
-pat_bit_size({atom,_La,all}=All, St) -> {All,St};
pat_bit_size({var,_Lv,_V}=Var, St) -> {Var,St};
pat_bit_size(Size, St) ->
Line = element(2, Size),
@@ -592,8 +552,7 @@ coerce_to_float({integer,L,I}=E, [float|_]) ->
try
{float,L,float(I)}
catch
- error:badarg -> E;
- error:badarith -> E
+ error:badarg -> E
end;
coerce_to_float(E, _) -> E.
@@ -647,25 +606,11 @@ string_to_conses(Line, Cs, Tail) ->
%% import(Line, Imports, State) ->
%% State'
-%% imported(Name, Arity, State) ->
-%% {yes,Module} | no
-%% Handle import declarations and test for imported functions. No need to
-%% check when building imports as code is correct.
+%% Handle import declarations.
-import({Mod,Fs}, St) ->
+import({Mod,Fs}, #expand{ctype=Ctype0}=St) ->
true = is_atom(Mod),
- Mfs = from_list(Fs),
- St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)}.
-
-add_imports(Mod, [F|Fs], Is) ->
- add_imports(Mod, Fs, orddict:store(F, Mod, Is));
-add_imports(_, [], Is) -> Is.
-
-imported(F, A, St) ->
- case orddict:find({F,A}, St#expand.imports) of
- {ok,Mod} -> {yes,Mod};
- error -> no
- end.
-
-defined(F, A, St) ->
- gb_sets:is_element({F,A}, St#expand.defined).
+ Ctype = foldl(fun(F, A) ->
+ A#{F=>{imported,Mod}}
+ end, Ctype0, Fs),
+ St#expand{ctype=Ctype}.
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 2a89305f4d..6f1912c616 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -827,21 +827,24 @@ select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf,
{bs_save2,CtxReg,{Ctx,Tl}}],Int1}
end,
{Es,clear_dead(Aft, I, Vdb),St};
-select_extract_bin([{var,Hd}], Size0, Unit, binary, Flags, Vf,
+select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf,
I, Vdb, Bef, Ctx, Body, St) ->
- SizeReg = get_bin_size_reg(Size0, Bef),
+ %% Match the last segment of a binary. We KNOW that the size
+ %% must be 'all'.
+ Size = {atom,all}, %Assertion.
{Es,Aft} =
case vdb_find(Hd, Vdb) of
{_,_,Lhd} when Lhd =< I ->
+ %% The result will not be used. Furthermore, since we
+ %% we are at the end of the binary, the position will
+ %% not be used again; thus, it is safe to do a cheaper
+ %% test of the unit.
CtxReg = fetch_var(Ctx, Bef),
- {case SizeReg =:= {atom,all} andalso is_context_unused(Body) of
- true when Unit =:= 1 ->
+ {case Unit of
+ 1 ->
[];
- true ->
- [{test,bs_test_unit,{f,Vf},[CtxReg,Unit]}];
- false ->
- [{test,bs_skip_bits2,{f,Vf},
- [CtxReg,SizeReg,Unit,{field_flags,Flags}]}]
+ _ ->
+ [{test,bs_test_unit,{f,Vf},[CtxReg,Unit]}]
end,Bef};
{_,_,_} ->
case is_context_unused(Body) of
@@ -853,7 +856,7 @@ select_extract_bin([{var,Hd}], Size0, Unit, binary, Flags, Vf,
Name = bs_get_binary2,
Live = max_reg(Bef#sr.reg),
{[{test,Name,{f,Vf},Live,
- [CtxReg,SizeReg,Unit,{field_flags,Flags}],Rhd}],
+ [CtxReg,Size,Unit,{field_flags,Flags}],Rhd}],
Int1};
true ->
%% Since the matching context will not be used again,
@@ -868,7 +871,7 @@ select_extract_bin([{var,Hd}], Size0, Unit, binary, Flags, Vf,
Name = bs_get_binary2,
Live = max_reg(Int1#sr.reg),
{[{test,Name,{f,Vf},Live,
- [CtxReg,SizeReg,Unit,{field_flags,Flags}],CtxReg}],
+ [CtxReg,Size,Unit,{field_flags,Flags}],CtxReg}],
Int1}
end
end,
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 7d93e2ae16..72649e5c9f 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -469,7 +469,8 @@ unforce_tree([#iset{var=#c_var{name=V},arg=Arg0}|Es], D0) ->
unforce_tree(Es, D);
unforce_tree([#icall{}=Call], D) ->
unforce_tree_subst(Call, D);
-unforce_tree([Top], _) -> Top.
+unforce_tree([#c_var{name=V}], D) ->
+ gb_trees:get(V, D).
unforce_tree_subst(#icall{module=#c_literal{val=erlang},
name=#c_literal{val='=:='},
@@ -1852,27 +1853,22 @@ uguard(Pg, Gs0, Ks, St0) ->
%% uexprs([Kexpr], [KnownVar], State) -> {[Kexpr],State}.
uexprs([#imatch{anno=A,pat=P0,arg=Arg,fc=Fc}|Les], Ks, St0) ->
- %% Optimise for simple set of unbound variable.
- case upattern(P0, Ks, St0) of
- {#c_var{},[],_Pvs,_Pus,_} ->
- %% Throw our work away and just set to iset.
+ case upat_is_new_var(P0, Ks) of
+ true ->
+ %% Assignment to a new variable.
uexprs([#iset{var=P0,arg=Arg}|Les], Ks, St0);
- _Other ->
- %% Throw our work away and set to icase.
- if
- Les =:= [] ->
- %% Need to explicitly return match "value", make
- %% safe for efficiency.
- {La0,Lps,St1} = force_safe(Arg, St0),
- La = mark_compiler_generated(La0),
- Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]},
- uexprs(Lps ++ [#icase{anno=A,
- args=[La0],clauses=[Mc],fc=Fc}], Ks, St1);
- true ->
- Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les},
- uexprs([#icase{anno=A,args=[Arg],
- clauses=[Mc],fc=Fc}], Ks, St0)
- end
+ false when Les =:= [] ->
+ %% Need to explicitly return match "value", make
+ %% safe for efficiency.
+ {La0,Lps,St1} = force_safe(Arg, St0),
+ La = mark_compiler_generated(La0),
+ Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]},
+ uexprs(Lps ++ [#icase{anno=A,
+ args=[La0],clauses=[Mc],fc=Fc}], Ks, St1);
+ false ->
+ Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les},
+ uexprs([#icase{anno=A,args=[Arg],
+ clauses=[Mc],fc=Fc}], Ks, St0)
end;
uexprs([Le0|Les0], Ks, St0) ->
{Le1,St1} = uexpr(Le0, Ks, St0),
@@ -1880,6 +1876,15 @@ uexprs([Le0|Les0], Ks, St0) ->
{[Le1|Les1],St2};
uexprs([], _, St) -> {[],St}.
+%% upat_is_new_var(Pattern, [KnownVar]) -> true|false.
+%% Test whether the pattern is a single, previously unknown
+%% variable.
+
+upat_is_new_var(#c_var{name=V}, Ks) ->
+ not is_element(V, Ks);
+upat_is_new_var(_, _) ->
+ false.
+
%% Mark a "safe" as compiler-generated.
mark_compiler_generated(#c_cons{anno=A,hd=H,tl=T}) ->
ann_c_cons([compiler_generated|A], mark_compiler_generated(H),
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 7ee564683b..4446d5ff1d 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1999-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.
@@ -117,7 +117,7 @@ copy_anno(Kdst, Ksrc) ->
fcount=0, %Fun counter
ds=cerl_sets:new() :: cerl_sets:set(), %Defined variables
funs=[], %Fun functions
- free=[], %Free variables
+ free=#{}, %Free variables
ws=[] :: [warning()], %Warnings.
guard_refc=0}). %> 0 means in guard
@@ -143,8 +143,10 @@ attributes([]) -> [].
include_attribute(type) -> false;
include_attribute(spec) -> false;
+include_attribute(callback) -> false;
include_attribute(opaque) -> false;
include_attribute(export_type) -> false;
+include_attribute(record) -> false;
include_attribute(_) -> true.
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
@@ -1837,14 +1839,17 @@ handle_reuse_anno_1(V, _St) -> V.
%% get_free(Name, Arity, State) -> [Free].
%% store_free(Name, Arity, [Free], State) -> State.
-get_free(F, A, St) ->
- case orddict:find({F,A}, St#kern.free) of
- {ok,Val} -> Val;
- error -> []
+get_free(F, A, #kern{free=FreeMap}) ->
+ Key = {F,A},
+ case FreeMap of
+ #{Key:=Val} -> Val;
+ _ -> []
end.
-store_free(F, A, Free, St) ->
- St#kern{free=orddict:store({F,A}, Free, St#kern.free)}.
+store_free(F, A, Free, #kern{free=FreeMap0}=St) ->
+ Key = {F,A},
+ FreeMap = FreeMap0#{Key=>Free},
+ St#kern{free=FreeMap}.
break_rets({break,Rs}) -> Rs;
break_rets(return) -> [].
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index 6553d10077..c2d757da4d 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -11,6 +11,8 @@ MODULES= \
beam_validator_SUITE \
beam_disasm_SUITE \
beam_except_SUITE \
+ beam_reorder_SUITE \
+ beam_type_SUITE \
beam_utils_SUITE \
bs_bincomp_SUITE \
bs_bit_binaries_SUITE \
@@ -43,6 +45,8 @@ NO_OPT= \
andor \
apply \
beam_except \
+ beam_reorder \
+ beam_type \
beam_utils \
bs_construct \
bs_match \
@@ -105,7 +109,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +clint0
+ERL_COMPILE_FLAGS += +clint +clint0
EBIN = .
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index fae9597c8a..264dc38907 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -25,7 +25,7 @@
combined/1,in_case/1,before_and_inside_if/1,
slow_compilation/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl
index 3425553fed..868bc674f9 100644
--- a/lib/compiler/test/apply_SUITE.erl
+++ b/lib/compiler/test/apply_SUITE.erl
@@ -24,7 +24,7 @@
-export([foo/0,bar/1,baz/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/beam_disasm_SUITE.erl b/lib/compiler/test/beam_disasm_SUITE.erl
index 4dd92e7ed9..4268729e75 100644
--- a/lib/compiler/test/beam_disasm_SUITE.erl
+++ b/lib/compiler/test/beam_disasm_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(beam_disasm_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]).
diff --git a/lib/compiler/test/beam_reorder_SUITE.erl b/lib/compiler/test/beam_reorder_SUITE.erl
new file mode 100644
index 0000000000..4b2262f65b
--- /dev/null
+++ b/lib/compiler/test/beam_reorder_SUITE.erl
@@ -0,0 +1,69 @@
+%%
+%% %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(beam_reorder_SUITE).
+
+-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ alloc/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ test_lib:recompile(?MODULE),
+ [{group,p}].
+
+groups() ->
+ [{p,[parallel],
+ [alloc
+ ]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+-record(alloc, {version}).
+
+alloc(_Config) ->
+ {ok,42} = alloc_a(1, 2, #alloc{version=42}),
+ {a,b,c} = alloc_b(1, 2, #alloc{version={a,b,c}}),
+ ok.
+
+alloc_a(_U1, _U2, R) ->
+ V = R#alloc.version,
+ Res = id({ok,V}),
+ _ = id(0),
+ Res.
+
+alloc_b(_U1, _U2, R) ->
+ V = R#alloc.version,
+ Res = id(V),
+ _ = id(0),
+ Res.
+
+id(I) ->
+ I.
diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl
new file mode 100644
index 0000000000..8d5c0190ed
--- /dev/null
+++ b/lib/compiler/test/beam_type_SUITE.erl
@@ -0,0 +1,98 @@
+%%
+%% %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(beam_type_SUITE).
+
+-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ integers/1,coverage/1,booleans/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ test_lib:recompile(?MODULE),
+ [{group,p}].
+
+groups() ->
+ [{p,[parallel],
+ [integers,
+ coverage,
+ booleans
+ ]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+integers(_Config) ->
+ a = do_integers_1(2#11000),
+ b = do_integers_1(2#11001),
+
+ a = do_integers_2(<<0:1>>),
+ {'EXIT',{{case_clause,-1},_}} = (catch do_integers_2(<<1:1>>)),
+
+ ok.
+
+do_integers_1(B0) ->
+ B = B0 band 1,
+ case B band 15 of
+ 0 -> a;
+ 1 -> b
+ end.
+
+do_integers_2(Bin) ->
+ <<B:1/signed>> = Bin,
+ case B of
+ 0 -> a;
+ 1 -> b
+ end.
+
+coverage(_Config) ->
+ {'EXIT',{badarith,_}} = (catch id(1) bsl 0.5),
+ {'EXIT',{badarith,_}} = (catch id(2.0) bsl 2),
+ {'EXIT',{badarith,_}} = (catch a + 0.5),
+ {'EXIT',{badarith,_}} = (catch 2.0 * b),
+
+ {'EXIT',{badarith,_}} = (catch id(42.0) / (1 bsl 2000)),
+
+ id(id(42) band 387439739874298734983787934283479243879),
+ id(-1 band id(13)),
+
+ ok.
+
+booleans(_Config) ->
+ {'EXIT',{{case_clause,_},_}} = (catch do_booleans(42)),
+ ok.
+
+do_booleans(B) ->
+ case is_integer(B) of
+ yes -> yes;
+ no -> no
+ end.
+
+id(I) ->
+ I.
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 69391b15eb..cb217e4655 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -34,7 +34,7 @@
undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1,
map_field_lists/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = test_server:timetrap(?t:minutes(10)),
@@ -107,13 +107,13 @@ xrange(Config) when is_list(Config) ->
{{bif,'+',{f,0},[{x,-1},{x,1}],{x,0}},4,
{uninitialized_reg,{x,-1}}}},
{{t,sum_2,2},
- {{bif,'+',{f,0},[{x,0},{x,1024}],{x,0}},4,
- {uninitialized_reg,{x,1024}}}},
+ {{bif,'+',{f,0},[{x,0},{x,1023}],{x,0}},4,
+ {uninitialized_reg,{x,1023}}}},
{{t,sum_3,2},
{{bif,'+',{f,0},[{x,0},{x,1}],{x,-1}},4,
{invalid_store,{x,-1},number}}},
{{t,sum_4,2},
- {{bif,'+',{f,0},[{x,0},{x,1}],{x,1024}},4,limit}}] = Errors,
+ {{bif,'+',{f,0},[{x,0},{x,1}],{x,1023}},4,limit}}] = Errors,
ok.
yrange(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/beam_validator_SUITE_data/xrange.S b/lib/compiler/test/beam_validator_SUITE_data/xrange.S
index c6f20288f7..a76408dde3 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/xrange.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/xrange.S
@@ -20,7 +20,7 @@
{label,3}.
{func_info,{atom,t},{atom,sum_2},2}.
{label,4}.
- {bif,'+',{f,0},[{x,0},{x,1024}],{x,0}}.
+ {bif,'+',{f,0},[{x,0},{x,1023}],{x,0}}.
{'%live',1}.
return.
@@ -38,7 +38,7 @@
{label,7}.
{func_info,{atom,t},{atom,sum_4},2}.
{label,8}.
- {bif,'+',{f,0},[{x,0},{x,1}],{x,1024}}.
+ {bif,'+',{f,0},[{x,0},{x,1}],{x,1023}}.
{'%live',1}.
return.
diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl
index 1bf4e9d4a7..d9865c3746 100644
--- a/lib/compiler/test/bs_bincomp_SUITE.erl
+++ b/lib/compiler/test/bs_bincomp_SUITE.erl
@@ -28,7 +28,7 @@
extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1,
nomatch/1,sizes/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl
index afee52c9b9..5bda20e6d6 100644
--- a/lib/compiler/test/bs_bit_binaries_SUITE.erl
+++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl
@@ -29,7 +29,7 @@
big_binary_to_and_from_list/1,send_and_receive/1,
send_and_receive_alot/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index 87cfaaf73c..caf204032c 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -31,7 +31,7 @@
nasty_literals/1,coerce_to_float/1,side_effect/1,
opt/1,otp_7556/1,float_arith/1,otp_8054/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 7fb0a16540..99539f3779 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -36,12 +36,12 @@
match_string/1,zero_width/1,bad_size/1,haystack/1,
cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1,
no_partition/1,calling_a_binary/1,binary_in_map/1,
- match_string_opt/1,map_and_binary/1,
- unsafe_branch_caching/1]).
+ match_string_opt/1,select_on_integer/1,
+ map_and_binary/1,unsafe_branch_caching/1]).
-export([coverage_id/1,coverage_external_ignore/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -63,8 +63,8 @@ groups() ->
otp_7498,match_string,zero_width,bad_size,haystack,
cover_beam_bool,matched_out_size,follow_fail_branch,
no_partition,calling_a_binary,binary_in_map,
- match_string_opt,map_and_binary,
- unsafe_branch_caching]}].
+ match_string_opt,select_on_integer,
+ map_and_binary,unsafe_branch_caching]}].
init_per_suite(Config) ->
@@ -118,9 +118,16 @@ fun_shadow_4(L) ->
int_float(Config) when is_list(Config) ->
%% OTP-5323
- ?line <<103133.0:64/float>> = <<103133:64/float>>,
- ?line <<103133:64/float>> = <<103133:64/float>>,
- ok.
+ <<103133.0:64/float>> = <<103133:64/float>>,
+ <<103133:64/float>> = <<103133:64/float>>,
+
+ %% Coverage of error cases in sys_pre_expand:coerce_to_float/2.
+ case id(default) of
+ <<(1 bsl 1024):64/float>> ->
+ ?t:fail();
+ default ->
+ ok
+ end.
%% Stolen from erl_eval_SUITE and modified.
%% OTP-5269. Bugs in the bit syntax.
@@ -1227,6 +1234,21 @@ match_string_opt(Config) when is_list(Config) ->
do_match_string_opt({<<1>>,{v,V}}=T) ->
{x,V,T}.
+select_on_integer(Config) when is_list(Config) ->
+ 42 = do_select_on_integer(<<42>>),
+ <<"abc">> = do_select_on_integer(<<128,"abc">>),
+
+ {'EXIT',_} = (catch do_select_on_integer(<<0:1>>)),
+ {'EXIT',_} = (catch do_select_on_integer(<<1:1>>)),
+ {'EXIT',_} = (catch do_select_on_integer(<<0:1,0:15>>)),
+ ok.
+
+%% The ASN.1 compiler frequently generates code like this.
+do_select_on_integer(<<0:1,I:7>>) ->
+ I;
+do_select_on_integer(<<1:1,_:7,Bin/binary>>) ->
+ Bin.
+
%% If 'bin_opt_info' was given the warning would lack filename
%% and line number.
diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl
index e6d292d9e6..ffe8de00d4 100644
--- a/lib/compiler/test/bs_utf_SUITE.erl
+++ b/lib/compiler/test/bs_utf_SUITE.erl
@@ -26,7 +26,7 @@
utf32_roundtrip/1,guard/1,extreme_tripping/1,
literals/1,coverage/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index 2715a3aec5..6bff5e55f2 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -20,7 +20,7 @@
-module(compilation_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile(export_all).
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index cbdd9ce8cd..c69e0ac408 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -21,7 +21,7 @@
%% Tests compile:file/1 and compile:file/2 with various options.
--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,
@@ -29,7 +29,7 @@
file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1,
binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
other_output/1, encrypted_abstr/1,
- bad_record_use1/1, bad_record_use2/1, strict_record/1,
+ strict_record/1,
missing_testheap/1, cover/1, env/1, core/1, asm/1,
sys_pre_attributes/1, dialyzer/1,
warnings/1
@@ -48,13 +48,12 @@ all() ->
[app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
other_output, encrypted_abstr,
- {group, bad_record_use}, strict_record,
+ strict_record,
missing_testheap, cover, env, core, asm,
sys_pre_attributes, dialyzer, warnings].
groups() ->
- [{bad_record_use, [],
- [bad_record_use1, bad_record_use2]}].
+ [].
init_per_suite(Config) ->
Config.
@@ -86,7 +85,7 @@ file_1(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ?line {Simple, Target} = files(Config, "file_1"),
+ {Simple, Target} = get_files(Config, simple, "file_1"),
?line {ok, Cwd} = file:get_cwd(),
?line ok = file:set_cwd(filename:dirname(Target)),
@@ -161,11 +160,8 @@ module_mismatch(Config) when is_list(Config) ->
big_file(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:minutes(5)),
- ?line DataDir = ?config(data_dir, Config),
- ?line PrivDir = ?config(priv_dir, Config),
- ?line Big = filename:join(DataDir, "big.erl"),
- ?line Target = filename:join(PrivDir, "big.beam"),
- ?line ok = file:set_cwd(PrivDir),
+ {Big,Target} = get_files(Config, big, "big_file"),
+ ok = file:set_cwd(filename:dirname(Target)),
?line compile_and_verify(Big, Target, []),
?line compile_and_verify(Big, Target, [debug_info]),
?line compile_and_verify(Big, Target, [no_postopt]),
@@ -179,7 +175,7 @@ big_file(Config) when is_list(Config) ->
outdir(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:seconds(60)),
- ?line {Simple, Target} = files(Config, "outdir"),
+ {Simple, Target} = get_files(Config, simple, "outdir"),
?line {ok, simple} = compile:file(Simple, [{outdir, filename:dirname(Target)}]),
?line true = exists(Target),
?line passed = run(Target, test, []),
@@ -192,7 +188,7 @@ outdir(Config) when is_list(Config) ->
binary(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:seconds(60)),
- ?line {Simple, Target} = files(Config, "binary"),
+ {Simple, Target} = get_files(Config, simple, "binary"),
?line {ok, simple, Binary} = compile:file(Simple, [binary]),
?line code:load_binary(simple, Target, Binary),
?line passed = simple:test(),
@@ -206,7 +202,7 @@ binary(Config) when is_list(Config) ->
makedep(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:seconds(60)),
- ?line {Simple,Target} = files(Config, "makedep"),
+ {Simple,Target} = get_files(Config, simple, "makedep"),
?line DataDir = ?config(data_dir, Config),
?line SimpleRootname = filename:rootname(Simple),
?line IncludeDir = filename:join(filename:dirname(Simple), "include"),
@@ -282,7 +278,7 @@ makedep_modify_target(Mf, Target) ->
cond_and_ifdef(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:seconds(60)),
- ?line {Simple, Target} = files(Config, "cond_and_ifdef"),
+ {Simple, Target} = get_files(Config, simple, "cond_and_ifdef"),
?line IncludeDir = filename:join(filename:dirname(Simple), "include"),
?line Options = [{outdir, filename:dirname(Target)},
{d, need_foo}, {d, foo_value, 42},
@@ -330,6 +326,8 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
do_listing(Simple, TargetDir, dlife, ".life"),
do_listing(Simple, TargetDir, dcg, ".codegen"),
do_listing(Simple, TargetDir, dblk, ".block"),
+ do_listing(Simple, TargetDir, dexcept, ".except"),
+ do_listing(Simple, TargetDir, dbs, ".bs"),
do_listing(Simple, TargetDir, dbool, ".bool"),
do_listing(Simple, TargetDir, dtype, ".type"),
do_listing(Simple, TargetDir, ddead, ".dead"),
@@ -360,21 +358,18 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
listings_big(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:minutes(10)),
- ?line DataDir = ?config(data_dir, Config),
- ?line PrivDir = ?config(priv_dir, Config),
- ?line Big = filename:join(DataDir, big),
- ?line TargetDir = filename:join(PrivDir, listings_big),
- ?line ok = file:make_dir(TargetDir),
+ {Big,Target} = get_files(Config, big, listings_big),
+ TargetDir = filename:dirname(Target),
?line do_listing(Big, TargetDir, 'S'),
?line do_listing(Big, TargetDir, 'E'),
?line do_listing(Big, TargetDir, 'P'),
?line do_listing(Big, TargetDir, dkern, ".kernel"),
- ?line Target = filename:join(TargetDir, big),
- {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]),
+ TargetNoext = filename:rootname(Target, code:objfile_extension()),
+ {ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]),
%% Cleanup.
- ?line ok = file:delete(Target ++ ".beam"),
+ ok = file:delete(Target),
?line lists:foreach(fun(F) -> ok = file:delete(F) end,
filelib:wildcard(filename:join(TargetDir, "*"))),
?line ok = file:del_dir(TargetDir),
@@ -383,11 +378,7 @@ listings_big(Config) when is_list(Config) ->
other_output(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:minutes(8)),
- ?line DataDir = ?config(data_dir, Config),
- ?line PrivDir = ?config(priv_dir, Config),
- ?line Simple = filename:join(DataDir, simple),
- ?line TargetDir = filename:join(PrivDir, other_output),
- ?line ok = file:make_dir(TargetDir),
+ {Simple,_Target} = get_files(Config, simple, "other_output"),
io:put_chars("to_pp"),
?line {ok,[],PP} = compile:file(Simple, [to_pp,binary,time]),
@@ -432,7 +423,7 @@ other_output(Config) when is_list(Config) ->
encrypted_abstr(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:minutes(10)),
- ?line {Simple,Target} = files(Config, "encrypted_abstr"),
+ {Simple,Target} = get_files(Config, simple, "encrypted_abstr"),
Res = case has_crypto() of
false ->
@@ -580,17 +571,17 @@ do_listing(Source, TargetDir, Type, Ext) ->
Target = filename:join(TargetDir, SourceBase ++ Ext),
true = exists(Target).
-files(Config, Name) ->
- ?line code:delete(simple),
- ?line code:purge(simple),
- ?line DataDir = ?config(data_dir, Config),
- ?line PrivDir = ?config(priv_dir, Config),
- ?line Simple = filename:join(DataDir, "simple"),
- ?line TargetDir = filename:join(PrivDir, Name),
- ?line ok = file:make_dir(TargetDir),
- ?line Target = filename:join(TargetDir, "simple"++code:objfile_extension()),
- {Simple, Target}.
-
+get_files(Config, Module, OutputName) ->
+ code:delete(Module),
+ code:purge(Module),
+ DataDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ Src = filename:join(DataDir, atom_to_list(Module)),
+ TargetDir = filename:join(PrivDir, OutputName),
+ ok = file:make_dir(TargetDir),
+ File = atom_to_list(Module) ++ code:objfile_extension(),
+ Target = filename:join(TargetDir, File),
+ {Src, Target}.
run(Target, Func, Args) ->
?line Module = list_to_atom(filename:rootname(filename:basename(Target))),
@@ -607,28 +598,6 @@ exists(Name) ->
end.
-%% Tests that the compiler does not accept
-%% bad use of records.
-bad_record_use1(Config) when is_list(Config) ->
- ?line {ok, Cwd} = file:get_cwd(),
- ?line file:set_cwd(?config(data_dir, Config)),
- ?line true=exists("bad_record_use.erl"),
- ?line Ret=c:c(bad_record_use),
- ?line file:set_cwd(Cwd),
- ?line error=Ret,
- ok.
-
-%% Tests that the compiler does not accept
-%% bad use of records.
-bad_record_use2(Config) when is_list(Config) ->
- ?line {ok, Cwd} = file:get_cwd(),
- ?line file:set_cwd(?config(data_dir, Config)),
- ?line true=exists("bad_record_use2.erl"),
- ?line Ret=c:c(bad_record_use),
- ?line file:set_cwd(Cwd),
- ?line error=Ret,
- ok.
-
strict_record(Config) when is_list(Config) ->
?line Priv = ?config(priv_dir, Config),
?line file:set_cwd(?config(data_dir, Config)),
@@ -713,7 +682,7 @@ init(ReplyTo, Fun, _Filler) ->
ReplyTo ! {result, Fun()}.
env(Config) when is_list(Config) ->
- ?line {Simple,Target} = files(Config, "file_1"),
+ {Simple,Target} = get_files(Config, simple, env),
?line {ok,Cwd} = file:get_cwd(),
?line ok = file:set_cwd(filename:dirname(Target)),
@@ -722,9 +691,9 @@ env(Config) when is_list(Config) ->
env_1(Simple, Target)
after
true = os:putenv("ERL_COMPILER_OPTIONS", "ignore_me"),
- file:set_cwd(Cwd),
- file:delete(Target),
- file:del_dir(filename:dirname(Target))
+ file:set_cwd(Cwd),
+ file:delete(Target),
+ file:del_dir(filename:dirname(Target))
end,
ok.
diff --git a/lib/compiler/test/compile_SUITE_data/bad_record_use.erl b/lib/compiler/test/compile_SUITE_data/bad_record_use.erl
deleted file mode 100644
index 0fb6fc3045..0000000000
--- a/lib/compiler/test/compile_SUITE_data/bad_record_use.erl
+++ /dev/null
@@ -1,29 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(bad_record_use).
--export([test/0]).
-
--record(bad_use, {a=undefined,
- b=undefined,
- c=undefined}).
-
-test() ->
- NewRecord=#bad_use{a=1, b=2, a=2}.
-
diff --git a/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl b/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl
deleted file mode 100644
index 7c898af00f..0000000000
--- a/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl
+++ /dev/null
@@ -1,30 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(bad_record_use2).
--export([test/0]).
-
--record(bad_use, {a=undefined,
- b=undefined,
- c=undefined}).
-
-test() ->
- R=#bad_use{a=1, b=2},
- R2=R#bad_use{a=1, b=2, a=2},
- ok.
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index 25f8564ce4..ddc4c7af5e 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -29,7 +29,7 @@
bs_shadowed_size_var/1
]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(comp(N),
N(Config) when is_list(Config) -> try_it(N, Config)).
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 016ea9d0d9..36faea1363 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -29,7 +29,7 @@
-export([foo/0,foo/1,foo/2,foo/3]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index 2962e3ff77..f4662ec7b2 100644
--- a/lib/compiler/test/error_SUITE.erl
+++ b/lib/compiler/test/error_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
-module(error_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,
diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl
index 1b313ad021..60efe4f228 100644
--- a/lib/compiler/test/float_SUITE.erl
+++ b/lib/compiler/test/float_SUITE.erl
@@ -22,7 +22,7 @@
init_per_group/2,end_per_group/2,
pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl
index 36a4d6fce2..c6cc5b17b3 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -27,7 +27,7 @@
%% Internal exports.
-export([call_me/1,dup1/0,dup2/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 47eb1ba78b..5391771dad 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(guard_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,
diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl
index 0b92a784de..f28e1e5a25 100644
--- a/lib/compiler/test/inline_SUITE.erl
+++ b/lib/compiler/test/inline_SUITE.erl
@@ -21,7 +21,7 @@
-module(inline_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile(export_all).
-compile({inline,[badarg/2]}).
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index d10839ccf2..43e23f3b46 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -26,7 +26,7 @@
empty_generator/1,no_export/1,shadow/1,
effect/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index cff3b5deb4..af98584e00 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -1885,7 +1885,7 @@ register_corruption_dummy_call(A,B,C) -> {A,B,C}.
t_frequency_table(Config) when is_list(Config) ->
- random:seed({13,1337,54}), % pseudo random
+ rand:seed(exsplus, {13,1337,54}), % pseudo random
N = 100000,
Ts = rand_terms(N),
#{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}),
@@ -1928,7 +1928,7 @@ rand_terms(0) -> [];
rand_terms(N) -> [rand_term()|rand_terms(N-1)].
rand_term() ->
- case random:uniform(6) of
+ case rand:uniform(6) of
1 -> rand_binary();
2 -> rand_number();
3 -> rand_atom();
@@ -1938,21 +1938,21 @@ rand_term() ->
end.
rand_binary() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> <<>>;
2 -> <<"hi">>;
3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">>
end.
rand_number() ->
- case random:uniform(3) of
- 1 -> random:uniform(5);
- 2 -> float(random:uniform(5));
- 3 -> 1 bsl (63 + random:uniform(3))
+ case rand:uniform(3) of
+ 1 -> rand:uniform(5);
+ 2 -> float(rand:uniform(5));
+ 3 -> 1 bsl (63 + rand:uniform(3))
end.
rand_atom() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> hi;
2 -> some_atom;
3 -> some_other_atom
@@ -1960,21 +1960,21 @@ rand_atom() ->
rand_tuple() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> {ok, rand_term()}; % careful
2 -> {1, 2, 3};
3 -> {<<"yep">>, 1337}
end.
rand_list() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> "hi";
2 -> [1,rand_term()]; % careful
3 -> [improper|list]
end.
rand_map() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> #{ hi => 3 };
2 -> #{ wat => rand_term(), other => 3 }; % careful
3 -> #{ hi => 42, other => 42, yet_anoter => 1337 }
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 67d668f650..8e88d26b62 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -26,7 +26,7 @@
selectify/1,underscore/1,match_map/1,map_vars_used/1,
coverage/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -449,7 +449,10 @@ do_map_vars_used(X, Y, Map) ->
coverage(Config) when is_list(Config) ->
%% Cover beam_dead.
ok = coverage_1(x, a),
- ok = coverage_1(x, b).
+ ok = coverage_1(x, b),
+
+ %% Cover sys_pre_expand.
+ ok = coverage_3("abc").
coverage_1(B, Tag) ->
case Tag of
@@ -460,4 +463,6 @@ coverage_1(B, Tag) ->
coverage_2(1, a, x) -> ok;
coverage_2(2, b, x) -> ok.
+coverage_3([$a]++[]++"bc") -> ok.
+
id(I) -> I.
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index 8606935504..9c65151685 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -25,7 +25,7 @@
tobias/1,empty_string/1,md5/1,silly_coverage/1,
confused_literals/1,integer_encoding/1,override_bif/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% For the override_bif testcase.
%% NB, no other testcases in this testsuite can use these without erlang:prefix!
@@ -38,7 +38,11 @@
-compile({no_auto_import,[byte_size/1]}).
-import(erlang,[byte_size/1]).
-
+%% Cover the code for callback handling.
+-callback must_define_this_one() -> 'ok'.
+-callback do_something_strange(atom()) -> 'ok'.
+-optional_callbacks([do_something_strange/1]).
+-optional_callbacks([ignore_me]). %Invalid; ignored.
%% Include an opaque declaration to cover the stripping of
%% opaque types from attributes in v3_kernel.
@@ -192,6 +196,14 @@ silly_coverage(Config) when is_list(Config) ->
{label,2}|non_proper_list]}],99},
expect_error(fun() -> beam_a:module(BeamAInput, []) end),
+ %% beam_reorder
+ BlockInput = {?MODULE,[{foo,0}],[],
+ [{function,foo,0,2,
+ [{label,1},
+ {func_info,{atom,?MODULE},{atom,foo},0},
+ {label,2}|non_proper_list]}],99},
+ expect_error(fun() -> beam_reorder:module(BlockInput, []) end),
+
%% beam_block
BlockInput = {?MODULE,[{foo,0}],[],
[{function,foo,0,2,
@@ -200,6 +212,10 @@ silly_coverage(Config) when is_list(Config) ->
{label,2}|non_proper_list]}],99},
?line expect_error(fun() -> beam_block:module(BlockInput, []) end),
+ %% beam_bs
+ BsInput = BlockInput,
+ expect_error(fun() -> beam_bs:module(BsInput, []) end),
+
%% beam_type
TypeInput = {?MODULE,[{foo,0}],[],
[{function,foo,0,2,
@@ -373,9 +389,9 @@ integer_encoding_1(Config) ->
do_integer_encoding(0, _, _, _) -> ok;
do_integer_encoding(N, I0, Src, Data) ->
- I1 = (I0 bsl 5) bor (random:uniform(32) - 1),
+ I1 = (I0 bsl 5) bor (rand:uniform(32) - 1),
do_integer_encoding(I1, Src, Data),
- I2 = -(I1 bxor (random:uniform(32) - 1)),
+ I2 = -(I1 bxor (rand:uniform(32) - 1)),
do_integer_encoding(I2, Src, Data),
do_integer_encoding(N-1, I1, Src, Data).
diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl
index d54fa203f0..a94ca40b38 100644
--- a/lib/compiler/test/num_bif_SUITE.erl
+++ b/lib/compiler/test/num_bif_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(num_bif_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Tests optimization of the BIFs:
%% abs/1
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index 4016fac0b5..fef29ab06d 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -27,7 +27,7 @@
export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1,
wait/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(_Case, Config) ->
?line Dog = test_server:timetrap(test_server:minutes(2)),
diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl
index 2ef379e43f..48a2a9f5df 100644
--- a/lib/compiler/test/record_SUITE.erl
+++ b/lib/compiler/test/record_SUITE.erl
@@ -21,7 +21,7 @@
-module(record_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,
diff --git a/lib/compiler/test/regressions_SUITE.erl b/lib/compiler/test/regressions_SUITE.erl
index 716a9693ed..a8caa34c60 100644
--- a/lib/compiler/test/regressions_SUITE.erl
+++ b/lib/compiler/test/regressions_SUITE.erl
@@ -19,7 +19,7 @@
%% Test specific code snippets that has crashed the compiler in the past.
-module(regressions_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([all/0, groups/0, init_per_testcase/2,end_per_testcase/2]).
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index 09ec8f3c81..e4b6a2fa9c 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -19,7 +19,7 @@
%%
-module(test_lib).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile({no_auto_import,[binary_part/2]}).
-export([id/1,recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1,
smoke_disasm/1,p_run/2,binary_part/2]).
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index adcab8ef67..b316776f50 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -28,7 +28,7 @@
plain_catch_coverage/1,andalso_orelse/1,get_in_try/1,
hockey/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index a964afe5a1..2a425c2ae5 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -27,7 +27,7 @@
-define(privdir, "warnings_SUITE_priv").
-define(t, test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(datadir, ?config(data_dir, Conf)).
-define(privdir, ?config(priv_dir, Conf)).
-endif.
diff --git a/lib/cosEvent/test/Makefile b/lib/cosEvent/test/Makefile
index 2d29afd20d..028b0221b6 100644
--- a/lib/cosEvent/test/Makefile
+++ b/lib/cosEvent/test/Makefile
@@ -96,12 +96,10 @@ TARGET_FILES = \
ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin
ERL_COMPILE_FLAGS += $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/test_server/ebin \
-pa $(ERL_TOP)/lib/cosEvent/ebin \
-pa $(ERL_TOP)/lib/cosEvent/test/idl_output \
-I$(ERL_TOP)/lib/cosEvent \
- -I$(ERL_TOP)/lib/cosEvent/test/$(IDLOUTDIR) \
- -I$(ERL_TOP)/lib/test_server/include
+ -I$(ERL_TOP)/lib/cosEvent/test/$(IDLOUTDIR)
# ----------------------------------------------------
# Targets
diff --git a/lib/cosEvent/test/event_channel_SUITE.erl b/lib/cosEvent/test/event_channel_SUITE.erl
index 0d67a94520..3a01a0eab6 100644
--- a/lib/cosEvent/test/event_channel_SUITE.erl
+++ b/lib/cosEvent/test/event_channel_SUITE.erl
@@ -23,7 +23,7 @@
-module(event_channel_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/cosEvent/test/generated_SUITE.erl b/lib/cosEvent/test/generated_SUITE.erl
index 40fe94386a..1533c0be9c 100644
--- a/lib/cosEvent/test/generated_SUITE.erl
+++ b/lib/cosEvent/test/generated_SUITE.erl
@@ -26,7 +26,7 @@
-module(generated_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/cosEventDomain/test/Makefile b/lib/cosEventDomain/test/Makefile
index 1bbd1f1693..d8f6a863d6 100644
--- a/lib/cosEventDomain/test/Makefile
+++ b/lib/cosEventDomain/test/Makefile
@@ -61,15 +61,13 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin
ERL_COMPILE_FLAGS += \
$(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/test_server/ebin \
-pa $(ERL_TOP)/lib/cosEventDomain/ebin \
-pa $(ERL_TOP)/lib/cosEventDomain/include \
-pa $(ERL_TOP)/lib/cosNotification/ebin \
-pa $(ERL_TOP)/lib/cosNotification/include \
-I$(ERL_TOP)/lib/cosEventDomain/include \
-I$(ERL_TOP)/lib/cosNotification/include \
- -I$(ERL_TOP)/lib/cosNotification/ebin \
- -I$(ERL_TOP)/lib/test_server/include
+ -I$(ERL_TOP)/lib/cosNotification/ebin
# ----------------------------------------------------
# Targets
diff --git a/lib/cosEventDomain/test/event_domain_SUITE.erl b/lib/cosEventDomain/test/event_domain_SUITE.erl
index 75835b03a0..37a04a34aa 100644
--- a/lib/cosEventDomain/test/event_domain_SUITE.erl
+++ b/lib/cosEventDomain/test/event_domain_SUITE.erl
@@ -23,7 +23,7 @@
-module(event_domain_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("cosNotification/include/CosNotifyChannelAdmin.hrl").
-include_lib("cosNotification/include/CosNotification.hrl").
diff --git a/lib/cosEventDomain/test/generated_SUITE.erl b/lib/cosEventDomain/test/generated_SUITE.erl
index 553516bed1..afaa70db0a 100644
--- a/lib/cosEventDomain/test/generated_SUITE.erl
+++ b/lib/cosEventDomain/test/generated_SUITE.erl
@@ -26,7 +26,7 @@
-module(generated_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/cosFileTransfer/test/Makefile b/lib/cosFileTransfer/test/Makefile
index 39512d83bd..332f90cb39 100644
--- a/lib/cosFileTransfer/test/Makefile
+++ b/lib/cosFileTransfer/test/Makefile
@@ -85,7 +85,6 @@ ERL_COMPILE_FLAGS += \
$(ERL_IDL_FLAGS) \
-pa $(ERL_TOP)/lib/orber/include \
-pa $(ERL_TOP)/lib/cosProperty/include \
- -pa $(ERL_TOP)/internal_tools/test_server/ebin \
-pa $(ERL_TOP)/lib/cosFileTransfer/ebin \
-pa $(ERL_TOP)/lib/cosFileTransfer/include \
-pa $(ERL_TOP)/lib/cosFileTransfer/test/idl_output \
@@ -94,8 +93,7 @@ ERL_COMPILE_FLAGS += \
-I$(ERL_TOP)/lib/cosFileTransfer/src \
-I$(ERL_TOP)/lib/cosFileTransfer/include \
-I$(ERL_TOP)/lib/cosFileTransfer \
- -I$(ERL_TOP)/lib/cosFileTransfer/test/$(IDLOUTDIR) \
- -I$(ERL_TOP)/lib/test_server/include
+ -I$(ERL_TOP)/lib/cosFileTransfer/test/$(IDLOUTDIR)
# ----------------------------------------------------
# Targets
diff --git a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl
index 3fb08dbcdd..173cf71e61 100644
--- a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl
+++ b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl
@@ -29,7 +29,7 @@
%%--------------- INCLUDES -----------------------------------
-include_lib("cosFileTransfer/src/cosFileTransferApp.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%--------------- DEFINES ------------------------------------
-define(default_timeout, ?t:minutes(20)).
diff --git a/lib/cosNotification/test/Makefile b/lib/cosNotification/test/Makefile
index 1db6d2bc14..5a4c5e18aa 100644
--- a/lib/cosNotification/test/Makefile
+++ b/lib/cosNotification/test/Makefile
@@ -128,7 +128,6 @@ ERL_IDL_FLAGS += \
ERL_COMPILE_FLAGS += \
$(ERL_IDL_FLAGS) \
-pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/internal_tools/test_server/ebin \
-pa $(ERL_TOP)/lib/cosEvent/ebin \
-pa $(ERL_TOP)/lib/cosNotification/ebin \
-pa $(ERL_TOP)/lib/cosNotification/test/idl_output \
@@ -142,8 +141,7 @@ ERL_COMPILE_FLAGS += \
-I$(ERL_TOP)/lib/cosNotification/src \
-I$(ERL_TOP)/lib/cosNotification/include \
-I$(ERL_TOP)/lib/cosNotification \
- -I$(ERL_TOP)/lib/cosNotification/test/$(IDLOUTDIR) \
- -I$(ERL_TOP)/lib/test_server/include
+ -I$(ERL_TOP)/lib/cosNotification/test/$(IDLOUTDIR)
# ----------------------------------------------------
# Targets
diff --git a/lib/cosNotification/test/eventDB_SUITE.erl b/lib/cosNotification/test/eventDB_SUITE.erl
index 0f0faed065..2d095adfae 100644
--- a/lib/cosNotification/test/eventDB_SUITE.erl
+++ b/lib/cosNotification/test/eventDB_SUITE.erl
@@ -42,7 +42,7 @@
-include("idl_output/notify_test.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%--------------- DEFINES ------------------------------------
-define(default_timeout, ?t:minutes(20)).
diff --git a/lib/cosNotification/test/generated_SUITE.erl b/lib/cosNotification/test/generated_SUITE.erl
index fe186f24e8..8e29989e30 100644
--- a/lib/cosNotification/test/generated_SUITE.erl
+++ b/lib/cosNotification/test/generated_SUITE.erl
@@ -26,7 +26,7 @@
-module(generated_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/cosNotification/test/grammar_SUITE.erl b/lib/cosNotification/test/grammar_SUITE.erl
index eb0741ce04..b17ddba1c4 100644
--- a/lib/cosNotification/test/grammar_SUITE.erl
+++ b/lib/cosNotification/test/grammar_SUITE.erl
@@ -43,7 +43,7 @@
-include("idl_output/notify_test.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%--------------- DEFINES ------------------------------------
-define(default_timeout, ?t:minutes(20)).
diff --git a/lib/cosNotification/test/notification_SUITE.erl b/lib/cosNotification/test/notification_SUITE.erl
index b3884e7968..6824a2805f 100644
--- a/lib/cosNotification/test/notification_SUITE.erl
+++ b/lib/cosNotification/test/notification_SUITE.erl
@@ -41,7 +41,7 @@
-include("idl_output/notify_test.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%--------------- DEFINES ------------------------------------
-define(default_timeout, ?t:minutes(20)).
diff --git a/lib/cosProperty/test/Makefile b/lib/cosProperty/test/Makefile
index ec928a9789..b5e063129d 100644
--- a/lib/cosProperty/test/Makefile
+++ b/lib/cosProperty/test/Makefile
@@ -82,14 +82,12 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosProperty/ebin \
ERL_COMPILE_FLAGS += \
$(ERL_IDL_FLAGS) \
-pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/internal_tools/test_server/ebin \
-pa $(ERL_TOP)/lib/cosProperty/ebin \
-pa $(ERL_TOP)/lib/cosProperty/test/idl_output \
-I$(ERL_TOP)/lib/orber/include \
-I$(ERL_TOP)/lib/cosProperty/src \
-I$(ERL_TOP)/lib/cosProperty \
- -I$(ERL_TOP)/lib/cosProperty/test/$(IDLOUTDIR) \
- -I$(ERL_TOP)/lib/test_server/include
+ -I$(ERL_TOP)/lib/cosProperty/test/$(IDLOUTDIR)
# ----------------------------------------------------
# Targets
diff --git a/lib/cosProperty/test/generated_SUITE.erl b/lib/cosProperty/test/generated_SUITE.erl
index 0422e0d018..1789650cbd 100644
--- a/lib/cosProperty/test/generated_SUITE.erl
+++ b/lib/cosProperty/test/generated_SUITE.erl
@@ -26,7 +26,7 @@
-module(generated_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/cosProperty/test/property_SUITE.erl b/lib/cosProperty/test/property_SUITE.erl
index 94765e7479..ae508fa7b6 100644
--- a/lib/cosProperty/test/property_SUITE.erl
+++ b/lib/cosProperty/test/property_SUITE.erl
@@ -33,7 +33,7 @@
-include_lib("cosProperty/src/cosProperty.hrl").
-include_lib("cosProperty/include/CosPropertyService.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%--------------- DEFINES ------------------------------------
-define(default_timeout, ?t:minutes(20)).
diff --git a/lib/cosTime/test/Makefile b/lib/cosTime/test/Makefile
index aabf855af5..003ea886a3 100644
--- a/lib/cosTime/test/Makefile
+++ b/lib/cosTime/test/Makefile
@@ -85,7 +85,6 @@ ERL_COMPILE_FLAGS += \
$(ERL_IDL_FLAGS) \
-pa $(ERL_TOP)/lib/orber/include \
-pa $(ERL_TOP)/lib/cosNotification/include \
- -pa $(ERL_TOP)/internal_tools/test_server/ebin \
-pa $(ERL_TOP)/lib/cosTime/ebin \
-pa $(ERL_TOP)/lib/cosTime/include \
-pa $(ERL_TOP)/lib/cosTime/test/idl_output \
@@ -94,8 +93,7 @@ ERL_COMPILE_FLAGS += \
-I$(ERL_TOP)/lib/cosTime/src \
-I$(ERL_TOP)/lib/cosTime/include \
-I$(ERL_TOP)/lib/cosTime \
- -I$(ERL_TOP)/lib/cosTime/test/$(IDLOUTDIR) \
- -I$(ERL_TOP)/lib/test_server/include
+ -I$(ERL_TOP)/lib/cosTime/test/$(IDLOUTDIR)
# ----------------------------------------------------
# Targets
diff --git a/lib/cosTime/test/generated_SUITE.erl b/lib/cosTime/test/generated_SUITE.erl
index 2e63b6f50e..03dffedc05 100644
--- a/lib/cosTime/test/generated_SUITE.erl
+++ b/lib/cosTime/test/generated_SUITE.erl
@@ -26,7 +26,7 @@
-module(generated_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/cosTime/test/time_SUITE.erl b/lib/cosTime/test/time_SUITE.erl
index 0e805aed05..7213680b99 100644
--- a/lib/cosTime/test/time_SUITE.erl
+++ b/lib/cosTime/test/time_SUITE.erl
@@ -30,7 +30,7 @@
%%--------------- INCLUDES -----------------------------------
-include_lib("cosTime/src/cosTimeApp.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%--------------- DEFINES ------------------------------------
-define(default_timeout, ?t:minutes(20)).
diff --git a/lib/cosTransactions/test/Makefile b/lib/cosTransactions/test/Makefile
index 3cdb05e7ef..9bcd461f04 100644
--- a/lib/cosTransactions/test/Makefile
+++ b/lib/cosTransactions/test/Makefile
@@ -93,13 +93,11 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosTransactions/ebin\
ERL_COMPILE_FLAGS += \
$(ERL_IDL_FLAGS) \
-pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/lib/test_server/ebin \
-pa $(ERL_TOP)/lib/cosTransactions/ebin \
-pa $(ERL_TOP)/lib/cosTransactions/test/idl_output \
-I$(ERL_TOP)/lib/orber/include \
-I$(ERL_TOP)/lib/cosTransactions \
- -I$(ERL_TOP)/lib/cosTransactions/test/$(IDLOUTDIR) \
- -I$(ERL_TOP)/lib/test_server/include
+ -I$(ERL_TOP)/lib/cosTransactions/test/$(IDLOUTDIR)
# ----------------------------------------------------
# Targets
diff --git a/lib/cosTransactions/test/generated_SUITE.erl b/lib/cosTransactions/test/generated_SUITE.erl
index 9d5cfb154a..c4bd86a892 100644
--- a/lib/cosTransactions/test/generated_SUITE.erl
+++ b/lib/cosTransactions/test/generated_SUITE.erl
@@ -27,7 +27,7 @@
-module(generated_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/cosTransactions/test/transactions_SUITE.erl b/lib/cosTransactions/test/transactions_SUITE.erl
index 0f06c3d262..63ec04f74f 100644
--- a/lib/cosTransactions/test/transactions_SUITE.erl
+++ b/lib/cosTransactions/test/transactions_SUITE.erl
@@ -29,7 +29,7 @@
-include_lib("cosTransactions/include/CosTransactions.hrl").
-include("etrap_test_lib.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(default_timeout, ?t:minutes(20)).
diff --git a/lib/crypto/Makefile b/lib/crypto/Makefile
index 24db75bf91..fbf108c410 100644
--- a/lib/crypto/Makefile
+++ b/lib/crypto/Makefile
@@ -24,11 +24,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
# Macros
#
-ifneq ($(findstring ose,$(TARGET)),ose)
SUB_DIRECTORIES = src c_src doc/src
-else
-SUB_DIRECTORIES = src doc/src
-endif
static_lib: SUB_DIRECTORIES = c_src
include vsn.mk
diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in
index e66c0ca916..e7f750b60a 100644
--- a/lib/crypto/c_src/Makefile.in
+++ b/lib/crypto/c_src/Makefile.in
@@ -127,12 +127,7 @@ ALL_STATIC_CFLAGS = $(DED_STATIC_CFLAGS) $(INCLUDES)
_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR))
-ifneq ($(findstring ose,$(TARGET)),ose)
debug opt valgrind: $(NIF_LIB) $(CALLBACK_LIB)
-else
-# Do not build dynamic files on OSE
-debug opt valgrind:
-endif
static_lib: $(NIF_ARCHIVE)
@@ -203,14 +198,12 @@ release_spec: opt
$(INSTALL_DIR) "$(RELSYSDIR)/priv/obj"
$(INSTALL_DIR) "$(RELSYSDIR)/priv/lib"
$(INSTALL_DATA) $(NIF_MAKEFILE) "$(RELSYSDIR)/priv/obj"
-ifneq ($(findstring ose,$(TARGET)),ose)
$(INSTALL_PROGRAM) $(CRYPTO_OBJS) "$(RELSYSDIR)/priv/obj"
$(INSTALL_PROGRAM) $(NIF_LIB) "$(RELSYSDIR)/priv/lib"
ifeq ($(DYNAMIC_CRYPTO_LIB),yes)
$(INSTALL_PROGRAM) $(CALLBACK_OBJS) "$(RELSYSDIR)/priv/obj"
$(INSTALL_PROGRAM) $(CALLBACK_LIB) "$(RELSYSDIR)/priv/lib"
endif
-endif
release_docs_spec:
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index 4966701e41..d1f620d892 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -91,6 +91,7 @@
#endif
#if OPENSSL_VERSION_NUMBER >= 0x1000100fL
+# define HAVE_EVP_AES_CTR
# define HAVE_GCM
#endif
@@ -98,6 +99,10 @@
# define HAVE_CHACHA20_POLY1305
#endif
+#if OPENSSL_VERSION_NUMBER <= 0x009080cfL
+# define HAVE_ECB_IVEC_BUG
+#endif
+
#if defined(HAVE_EC)
#include <openssl/ec.h>
#include <openssl/ecdh.h>
@@ -193,57 +198,20 @@ static void unload(ErlNifEnv* env, void* priv_data);
/* The NIFs: */
static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM md5_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM ripemd160(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM ripemd160_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM ripemd160_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM ripemd160_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha224_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha224_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha224_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha224_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha256_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha256_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha384_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha384_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha384_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha384_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha512_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha512_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha224_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha256_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha384_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -252,13 +220,10 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER
static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -270,10 +235,6 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T
static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -291,32 +252,7 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER
/* helpers */
static void init_algorithms_types(ErlNifEnv*);
static void init_digest_types(ErlNifEnv* env);
-static void hmac_md5(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf);
-static void hmac_sha1(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf);
-#ifdef HAVE_SHA224
-static void hmac_sha224(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf);
-#endif
-#ifdef HAVE_SHA256
-static void hmac_sha256(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf);
-#endif
-#ifdef HAVE_SHA384
-static void hmac_sha384(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf);
-#endif
-#ifdef HAVE_SHA512
-static void hmac_sha512(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf);
-#endif
+static void init_cipher_types(ErlNifEnv* env);
#ifdef HAVE_EC
static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg);
static int term2point(ErlNifEnv* env, ERL_NIF_TERM term,
@@ -328,60 +264,25 @@ static int library_refc = 0; /* number of users of this dynamic library */
static ErlNifFunc nif_funcs[] = {
{"info_lib", 0, info_lib},
{"algorithms", 0, algorithms},
- {"md5", 1, md5},
- {"md5_init", 0, md5_init},
- {"md5_update", 2, md5_update},
- {"md5_final", 1, md5_final},
- {"ripemd160", 1, ripemd160},
- {"ripemd160_init", 0, ripemd160_init},
- {"ripemd160_update", 2, ripemd160_update},
- {"ripemd160_final", 1, ripemd160_final},
- {"sha", 1, sha},
- {"sha_init", 0, sha_init},
- {"sha_update", 2, sha_update},
- {"sha_final", 1, sha_final},
- {"sha224_nif", 1, sha224_nif},
- {"sha224_init_nif", 0, sha224_init_nif},
- {"sha224_update_nif", 2, sha224_update_nif},
- {"sha224_final_nif", 1, sha224_final_nif},
- {"sha256_nif", 1, sha256_nif},
- {"sha256_init_nif", 0, sha256_init_nif},
- {"sha256_update_nif", 2, sha256_update_nif},
- {"sha256_final_nif", 1, sha256_final_nif},
- {"sha384_nif", 1, sha384_nif},
- {"sha384_init_nif", 0, sha384_init_nif},
- {"sha384_update_nif", 2, sha384_update_nif},
- {"sha384_final_nif", 1, sha384_final_nif},
- {"sha512_nif", 1, sha512_nif},
- {"sha512_init_nif", 0, sha512_init_nif},
- {"sha512_update_nif", 2, sha512_update_nif},
- {"sha512_final_nif", 1, sha512_final_nif},
- {"md4", 1, md4},
- {"md4_init", 0, md4_init},
- {"md4_update", 2, md4_update},
- {"md4_final", 1, md4_final},
- {"md5_mac_n", 3, md5_mac_n},
- {"sha_mac_n", 3, sha_mac_n},
- {"sha224_mac_nif", 3, sha224_mac_nif},
- {"sha256_mac_nif", 3, sha256_mac_nif},
- {"sha384_mac_nif", 3, sha384_mac_nif},
- {"sha512_mac_nif", 3, sha512_mac_nif},
- {"hmac_init", 2, hmac_init},
- {"hmac_update", 2, hmac_update},
- {"hmac_final", 1, hmac_final},
- {"hmac_final_n", 2, hmac_final},
- {"des_cbc_crypt", 4, des_cbc_crypt},
- {"des_cfb_crypt", 4, des_cfb_crypt},
- {"des_ecb_crypt", 3, des_ecb_crypt},
- {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt},
- {"des_ede3_cfb_crypt_nif", 6, des_ede3_cfb_crypt_nif},
- {"aes_cfb_8_crypt", 4, aes_cfb_8_crypt},
- {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt},
+ {"hash_nif", 2, hash_nif},
+ {"hash_init_nif", 1, hash_init_nif},
+ {"hash_update_nif", 2, hash_update_nif},
+ {"hash_final_nif", 1, hash_final_nif},
+ {"hmac_nif", 3, hmac_nif},
+ {"hmac_nif", 4, hmac_nif},
+ {"hmac_init_nif", 2, hmac_init_nif},
+ {"hmac_update_nif", 2, hmac_update_nif},
+ {"hmac_final_nif", 1, hmac_final_nif},
+ {"hmac_final_nif", 2, hmac_final_nif},
+ {"block_crypt_nif", 5, block_crypt_nif},
+ {"block_crypt_nif", 4, block_crypt_nif},
+ {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif},
+
{"aes_ctr_encrypt", 3, aes_ctr_encrypt},
{"aes_ctr_decrypt", 3, aes_ctr_encrypt},
+ {"aes_ctr_stream_init", 2, aes_ctr_stream_init},
{"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt},
{"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt},
- {"aes_ecb_crypt", 3, aes_ecb_crypt},
{"rand_bytes", 1, rand_bytes_1},
{"strong_rand_bytes_nif", 1, strong_rand_bytes_nif},
{"rand_bytes", 3, rand_bytes_3},
@@ -390,13 +291,10 @@ static ErlNifFunc nif_funcs[] = {
{"mod_exp_nif", 4, mod_exp_nif},
{"dss_verify_nif", 4, dss_verify_nif},
{"rsa_verify_nif", 4, rsa_verify_nif},
- {"aes_cbc_crypt", 4, aes_cbc_crypt},
- {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif},
{"do_exor", 2, do_exor},
{"rc4_encrypt", 2, rc4_encrypt},
{"rc4_set_key", 1, rc4_set_key},
{"rc4_encrypt_with_state", 2, rc4_encrypt_with_state},
- {"rc2_cbc_crypt", 4, rc2_cbc_crypt},
{"rsa_sign_nif", 3, rsa_sign_nif},
{"dss_sign_nif", 3, dss_sign_nif},
{"rsa_public_crypt", 4, rsa_public_crypt},
@@ -408,10 +306,6 @@ static ErlNifFunc nif_funcs[] = {
{"srp_value_B_nif", 5, srp_value_B_nif},
{"srp_user_secret_nif", 7, srp_user_secret_nif},
{"srp_host_secret_nif", 5, srp_host_secret_nif},
- {"bf_cfb64_crypt", 4, bf_cfb64_crypt},
- {"bf_cbc_crypt", 4, bf_cbc_crypt},
- {"bf_ecb_crypt", 3, bf_ecb_crypt},
- {"blowfish_ofb64_encrypt", 3, blowfish_ofb64_encrypt},
{"ec_key_generate", 2, ec_key_generate},
{"ecdsa_sign_nif", 4, ecdsa_sign_nif},
@@ -432,37 +326,14 @@ static ErlNifFunc nif_funcs[] = {
ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload)
-#define MD5_CTX_LEN (sizeof(MD5_CTX))
-#define MD5_LEN 16
-#define MD5_LEN_96 12
-#define MD4_CTX_LEN (sizeof(MD4_CTX))
-#define MD4_LEN 16
+#define MD5_CTX_LEN (sizeof(MD5_CTX))
+#define MD4_CTX_LEN (sizeof(MD4_CTX))
#define RIPEMD160_CTX_LEN (sizeof(RIPEMD160_CTX))
-#define RIPEMD160_LEN 20
-#define SHA_CTX_LEN (sizeof(SHA_CTX))
-#define SHA_LEN 20
-#define SHA_LEN_96 12
-#define SHA224_LEN (224/8)
-#define SHA256_LEN (256/8)
-#define SHA384_LEN (384/8)
-#define SHA512_LEN (512/8)
-#define HMAC_INT_LEN 64
-#define HMAC_INT2_LEN 128
-
-#define HMAC_IPAD 0x36
-#define HMAC_OPAD 0x5c
static ERL_NIF_TERM atom_true;
static ERL_NIF_TERM atom_false;
static ERL_NIF_TERM atom_sha;
-static ERL_NIF_TERM atom_sha224;
-static ERL_NIF_TERM atom_sha256;
-static ERL_NIF_TERM atom_sha384;
-static ERL_NIF_TERM atom_sha512;
-static ERL_NIF_TERM atom_md5;
-static ERL_NIF_TERM atom_md4;
-static ERL_NIF_TERM atom_ripemd160;
static ERL_NIF_TERM atom_error;
static ERL_NIF_TERM atom_rsa_pkcs1_padding;
static ERL_NIF_TERM atom_rsa_pkcs1_oaep_padding;
@@ -489,6 +360,14 @@ static ERL_NIF_TERM atom_ppbasis;
static ERL_NIF_TERM atom_onbasis;
#endif
+static ERL_NIF_TERM atom_aes_cfb8;
+static ERL_NIF_TERM atom_aes_cfb128;
+#ifdef HAVE_ECB_IVEC_BUG
+static ERL_NIF_TERM atom_aes_ecb;
+static ERL_NIF_TERM atom_des_ecb;
+static ERL_NIF_TERM atom_blowfish_ecb;
+#endif
+
static ErlNifResourceType* hmac_context_rtype;
struct hmac_context
{
@@ -498,6 +377,91 @@ struct hmac_context
};
static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*);
+struct digest_type_t {
+ const char* type_str;
+ const EVP_MD* (*md_func)(void); /* NULL if notsup */
+ ERL_NIF_TERM type_atom;
+};
+
+struct digest_type_t digest_types[] =
+{
+ {"md4", &EVP_md4},
+ {"md5", &EVP_md5},
+ {"ripemd160", &EVP_ripemd160},
+ {"sha", &EVP_sha1},
+ {"sha224",
+#ifdef HAVE_SHA224
+ &EVP_sha224
+#else
+ NULL
+#endif
+ },
+ {"sha256",
+#ifdef HAVE_SHA256
+ &EVP_sha256
+#else
+ NULL
+#endif
+ },
+ {"sha384",
+#ifdef HAVE_SHA384
+ &EVP_sha384
+#else
+ NULL
+#endif
+ },
+ {"sha512",
+#ifdef HAVE_SHA512
+ &EVP_sha512
+#else
+ NULL
+#endif
+ },
+ {NULL}
+};
+
+static struct digest_type_t* get_digest_type(ERL_NIF_TERM type);
+
+struct cipher_type_t {
+ const char* type_str;
+ const EVP_CIPHER* (*cipher_func)(void); /* NULL if notsup */
+ const size_t key_len; /* != 0 to also match on key_len */
+ ERL_NIF_TERM type_atom;
+};
+
+struct cipher_type_t cipher_types[] =
+{
+ {"rc2_cbc", &EVP_rc2_cbc},
+ {"des_cbc", &EVP_des_cbc},
+ {"des_cfb", &EVP_des_cfb8},
+ {"des_ecb", &EVP_des_ecb},
+ {"des_ede3_cbc", &EVP_des_ede3_cbc},
+ {"des_ede3_cbf",
+#ifdef HAVE_DES_ede3_cfb_encrypt
+ &EVP_des_ede3_cfb8
+#else
+ NULL
+#endif
+ },
+ {"blowfish_cbc", &EVP_bf_cbc},
+ {"blowfish_cfb64", &EVP_bf_cfb64},
+ {"blowfish_ofb64", &EVP_bf_ofb},
+ {"blowfish_ecb", &EVP_bf_ecb},
+ {"aes_cbc", &EVP_aes_128_cbc, 16},
+ {"aes_cbc", &EVP_aes_192_cbc, 24},
+ {"aes_cbc", &EVP_aes_256_cbc, 32},
+ {"aes_cbc128", &EVP_aes_128_cbc},
+ {"aes_cbc256", &EVP_aes_256_cbc},
+ {"aes_cfb8", &EVP_aes_128_cfb8},
+ {"aes_cfb128", &EVP_aes_128_cfb128},
+ {"aes_ecb", &EVP_aes_128_ecb, 16},
+ {"aes_ecb", &EVP_aes_192_ecb, 24},
+ {"aes_ecb", &EVP_aes_256_ecb, 32},
+ {NULL}
+};
+
+static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len);
+
/*
#define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n")
#define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1)
@@ -507,47 +471,21 @@ static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*);
#define PRINTF_ERR1(FMT,A1)
#define PRINTF_ERR2(FMT,A1,A2)
-#ifdef __OSE__
-
-/* For crypto on OSE we have to initialize the crypto library on each
- process that uses it. So since we do not know which scheduler is going
- to execute the nif we have to check before each nif call that we have
- initialized crypto in that process. */
-
-#include "ose.h"
-#include "openssl/osessl.h"
-
-static ErlNifTSDKey crypto_init_key;
-static int check_ose_crypto(void);
-static int init_ose_crypto(void);
-
-static int check_ose_crypto() {
- int key = (int)enif_tsd_get(crypto_init_key);
- if (!key) {
- if (!CRYPTO_OSE5_init()) {
- PRINTF_ERR0("CRYPTO: Call to CRYPTO_OSE5_init failed");
- return 0;
- }
- enif_tsd_set(crypto_init_key,1);
- }
- return 1;
+#if OPENSSL_VERSION_NUMBER >= 0x1000000fL
+/* Define resource types for OpenSSL context structures. */
+static ErlNifResourceType* evp_md_ctx_rtype;
+static void evp_md_ctx_dtor(ErlNifEnv* env, EVP_MD_CTX* ctx) {
+ EVP_MD_CTX_cleanup(ctx);
}
+#endif
-static int init_ose_crypto() {
- /* Crypto nif upgrade does not work on OSE so no need to
- destroy this key */
- enif_tsd_key_create("crypto_init_key", &crypto_init_key);
- return check_ose_crypto();
+#ifdef HAVE_EVP_AES_CTR
+static ErlNifResourceType* evp_cipher_ctx_rtype;
+static void evp_cipher_ctx_dtor(ErlNifEnv* env, EVP_CIPHER_CTX* ctx) {
+ EVP_CIPHER_CTX_cleanup(ctx);
}
-
-#define INIT_OSE_CRYPTO() init_ose_crypto()
-#define CHECK_OSE_CRYPTO() check_ose_crypto()
-#else
-#define INIT_OSE_CRYPTO() 1
-#define CHECK_OSE_CRYPTO()
#endif
-
static int verify_lib_version(void)
{
const unsigned long libv = SSLeay();
@@ -563,7 +501,6 @@ static int verify_lib_version(void)
return 1;
}
-
#ifdef HAVE_DYNAMIC_CRYPTO_LIB
# if defined(DEBUG)
@@ -599,7 +536,9 @@ static void error_handler(void* null, const char* errstr)
static int init(ErlNifEnv* env, ERL_NIF_TERM load_info)
{
+#ifdef OPENSSL_THREADS
ErlNifSysInfo sys_info;
+#endif
get_crypto_callbacks_t* funcp;
struct crypto_callbacks* ccb;
int nlocks = 0;
@@ -609,9 +548,6 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info)
ErlNifBinary lib_bin;
char lib_buf[1000];
- if (!INIT_OSE_CRYPTO())
- return 0;
-
if (!verify_lib_version())
return 0;
@@ -634,7 +570,26 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info)
PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'");
return 0;
}
-
+#if OPENSSL_VERSION_NUMBER >= 0x1000000fL
+ evp_md_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_MD_CTX",
+ (ErlNifResourceDtor*) evp_md_ctx_dtor,
+ ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER,
+ NULL);
+ if (!evp_md_ctx_rtype) {
+ PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_MD_CTX'");
+ return 0;
+ }
+#endif
+#ifdef HAVE_EVP_AES_CTR
+ evp_cipher_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_CIPHER_CTX",
+ (ErlNifResourceDtor*) evp_cipher_ctx_dtor,
+ ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER,
+ NULL);
+ if (!evp_cipher_ctx_rtype) {
+ PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_CIPHER_CTX'");
+ return 0;
+ }
+#endif
if (library_refc > 0) {
/* Repeated loading of this library (module upgrade).
* Atoms and callbacks are already set, we are done.
@@ -642,16 +597,9 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info)
return 1;
}
- atom_true = enif_make_atom(env,"true");
+ atom_true = enif_make_atom(env,"true");
atom_false = enif_make_atom(env,"false");
atom_sha = enif_make_atom(env,"sha");
- atom_sha224 = enif_make_atom(env,"sha224");
- atom_sha256 = enif_make_atom(env,"sha256");
- atom_sha384 = enif_make_atom(env,"sha384");
- atom_sha512 = enif_make_atom(env,"sha512");
- atom_md4 = enif_make_atom(env,"md4");
- atom_md5 = enif_make_atom(env,"md5");
- atom_ripemd160 = enif_make_atom(env,"ripemd160");
atom_error = enif_make_atom(env,"error");
atom_rsa_pkcs1_padding = enif_make_atom(env,"rsa_pkcs1_padding");
atom_rsa_pkcs1_oaep_padding = enif_make_atom(env,"rsa_pkcs1_oaep_padding");
@@ -676,8 +624,16 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info)
atom_ppbasis = enif_make_atom(env,"ppbasis");
atom_onbasis = enif_make_atom(env,"onbasis");
#endif
+ atom_aes_cfb8 = enif_make_atom(env, "aes_cfb8");
+ atom_aes_cfb128 = enif_make_atom(env, "aes_cfb128");
+#ifdef HAVE_ECB_IVEC_BUG
+ atom_aes_ecb = enif_make_atom(env, "aes_ecb");
+ atom_des_ecb = enif_make_atom(env, "des_ecb");
+ atom_blowfish_ecb = enif_make_atom(env, "blowfish_ecb");
+#endif
init_digest_types(env);
+ init_cipher_types(env);
init_algorithms_types(env);
#ifdef HAVE_DYNAMIC_CRYPTO_LIB
@@ -762,46 +718,67 @@ static void unload(ErlNifEnv* env, void* priv_data)
static int algo_hash_cnt;
static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */
static int algo_pubkey_cnt;
-static ERL_NIF_TERM algo_pubkey[3]; /* increase when extending the list */
+static ERL_NIF_TERM algo_pubkey[7]; /* increase when extending the list */
static int algo_cipher_cnt;
-static ERL_NIF_TERM algo_cipher[4]; /* increase when extending the list */
+static ERL_NIF_TERM algo_cipher[20]; /* increase when extending the list */
static void init_algorithms_types(ErlNifEnv* env)
{
algo_hash_cnt = 0;
- algo_hash[algo_hash_cnt++] = atom_md4;
- algo_hash[algo_hash_cnt++] = atom_md5;
algo_hash[algo_hash_cnt++] = atom_sha;
- algo_hash[algo_hash_cnt++] = atom_ripemd160;
#ifdef HAVE_SHA224
- algo_hash[algo_hash_cnt++] = atom_sha224;
+ algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha224");
#endif
#ifdef HAVE_SHA256
- algo_hash[algo_hash_cnt++] = atom_sha256;
+ algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha256");
#endif
#ifdef HAVE_SHA384
- algo_hash[algo_hash_cnt++] = atom_sha384;
+ algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha384");
#endif
#ifdef HAVE_SHA512
- algo_hash[algo_hash_cnt++] = atom_sha512;
+ algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha512");
#endif
+ algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md4");
+ algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md5");
+ algo_hash[algo_hash_cnt++] = enif_make_atom(env, "ripemd160");
algo_pubkey_cnt = 0;
+ algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "rsa");
+ algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dss");
+ algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dh");
#if defined(HAVE_EC)
#if !defined(OPENSSL_NO_EC2M)
- algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env,"ec_gf2m");
+ algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ec_gf2m");
#endif
- algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env,"ecdsa");
- algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env,"ecdh");
+ algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ecdsa");
+ algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ecdh");
#endif
+ algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "srp");
algo_cipher_cnt = 0;
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cbc");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des_ede3");
#ifdef HAVE_DES_ede3_cfb_encrypt
algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cbf");
#endif
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc128");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb8");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb128");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc256");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ctr");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ecb");
#ifdef HAVE_AES_IGE
algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_ige256");
#endif
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cbc");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cfb");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_cbc");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_cfb64");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_ofb64");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_ecb");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc2_cbc");
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc4");
#if defined(HAVE_GCM)
algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_gcm");
#endif
@@ -816,10 +793,13 @@ static void init_algorithms_types(ErlNifEnv* env)
static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
+ int hash_cnt = algo_hash_cnt;
+ int pubkey_cnt = algo_pubkey_cnt;
+ int cipher_cnt = algo_cipher_cnt;
return enif_make_tuple3(env,
- enif_make_list_from_array(env, algo_hash, algo_hash_cnt),
- enif_make_list_from_array(env, algo_pubkey, algo_pubkey_cnt),
- enif_make_list_from_array(env, algo_cipher, algo_cipher_cnt));
+ enif_make_list_from_array(env, algo_hash, hash_cnt),
+ enif_make_list_from_array(env, algo_pubkey, pubkey_cnt),
+ enif_make_list_from_array(env, algo_cipher, cipher_cnt));
}
static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -849,601 +829,383 @@ static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
ver_term));
}
-static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Data) */
- ErlNifBinary ibin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) {
- return enif_make_badarg(env);
- }
- MD5((unsigned char *) ibin.data, ibin.size,
- enif_make_new_binary(env,MD5_LEN, &ret));
- CONSUME_REDS(env,ibin);
- return ret;
-}
-static ERL_NIF_TERM md5_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* () */
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- MD5_Init((MD5_CTX *) enif_make_new_binary(env, MD5_CTX_LEN, &ret));
- return ret;
-}
-static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context, Data) */
- MD5_CTX* new_ctx;
- ErlNifBinary ctx_bin, data_bin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin)
- || ctx_bin.size != MD5_CTX_LEN
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
+static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Type, Data) */
+ struct digest_type_t *digp = NULL;
+ const EVP_MD *md;
+ ErlNifBinary data;
+ ERL_NIF_TERM ret;
+ unsigned ret_size;
+
+ digp = get_digest_type(argv[0]);
+ if (!digp ||
+ !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
return enif_make_badarg(env);
}
- new_ctx = (MD5_CTX*) enif_make_new_binary(env,MD5_CTX_LEN, &ret);
- memcpy(new_ctx, ctx_bin.data, MD5_CTX_LEN);
- MD5_Update(new_ctx, data_bin.data, data_bin.size);
- CONSUME_REDS(env,data_bin);
- return ret;
-}
-static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context) */
- ErlNifBinary ctx_bin;
- MD5_CTX ctx_clone;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD5_CTX_LEN) {
- return enif_make_badarg(env);
+ if (!digp->md_func) {
+ return atom_notsup;
}
- memcpy(&ctx_clone, ctx_bin.data, MD5_CTX_LEN); /* writable */
- MD5_Final(enif_make_new_binary(env, MD5_LEN, &ret), &ctx_clone);
- return ret;
-}
-static ERL_NIF_TERM ripemd160(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Data) */
- ErlNifBinary ibin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) {
- return enif_make_badarg(env);
+ md = digp->md_func();
+ ret_size = (unsigned)EVP_MD_size(md);
+ ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE);
+ if (!EVP_Digest(data.data, data.size,
+ enif_make_new_binary(env, ret_size, &ret), &ret_size,
+ md, NULL)) {
+ return atom_notsup;
}
- RIPEMD160((unsigned char *) ibin.data, ibin.size,
- enif_make_new_binary(env,RIPEMD160_LEN, &ret));
- CONSUME_REDS(env,ibin);
- return ret;
-}
-static ERL_NIF_TERM ripemd160_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* () */
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- RIPEMD160_Init((RIPEMD160_CTX *) enif_make_new_binary(env, RIPEMD160_CTX_LEN, &ret));
+ ASSERT(ret_size == (unsigned)EVP_MD_size(md));
+
+ CONSUME_REDS(env, data);
return ret;
}
-static ERL_NIF_TERM ripemd160_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context, Data) */
- RIPEMD160_CTX* new_ctx;
- ErlNifBinary ctx_bin, data_bin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin)
- || ctx_bin.size != RIPEMD160_CTX_LEN
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
+
+#if OPENSSL_VERSION_NUMBER >= 0x1000000fL
+
+static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Type) */
+ struct digest_type_t *digp = NULL;
+ EVP_MD_CTX *ctx;
+ ERL_NIF_TERM ret;
+
+ digp = get_digest_type(argv[0]);
+ if (!digp) {
return enif_make_badarg(env);
}
- new_ctx = (RIPEMD160_CTX*) enif_make_new_binary(env,RIPEMD160_CTX_LEN, &ret);
- memcpy(new_ctx, ctx_bin.data, RIPEMD160_CTX_LEN);
- RIPEMD160_Update(new_ctx, data_bin.data, data_bin.size);
- CONSUME_REDS(env, data_bin);
- return ret;
-}
-static ERL_NIF_TERM ripemd160_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context) */
- ErlNifBinary ctx_bin;
- RIPEMD160_CTX ctx_clone;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != RIPEMD160_CTX_LEN) {
- return enif_make_badarg(env);
+ if (!digp->md_func) {
+ return atom_notsup;
}
- memcpy(&ctx_clone, ctx_bin.data, RIPEMD160_CTX_LEN); /* writable */
- RIPEMD160_Final(enif_make_new_binary(env, RIPEMD160_LEN, &ret), &ctx_clone);
- return ret;
-}
-
-static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Data) */
- ErlNifBinary ibin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) {
- return enif_make_badarg(env);
+ ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(EVP_MD_CTX));
+ if (!EVP_DigestInit(ctx, digp->md_func())) {
+ enif_release_resource(ctx);
+ return atom_notsup;
}
- SHA1((unsigned char *) ibin.data, ibin.size,
- enif_make_new_binary(env,SHA_LEN, &ret));
- CONSUME_REDS(env,ibin);
- return ret;
-}
-static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* () */
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- SHA1_Init((SHA_CTX *) enif_make_new_binary(env, SHA_CTX_LEN, &ret));
+ ret = enif_make_resource(env, ctx);
+ enif_release_resource(ctx);
return ret;
}
-static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Context, Data) */
- SHA_CTX* new_ctx;
- ErlNifBinary ctx_bin, data_bin;
+ EVP_MD_CTX *ctx, *new_ctx;
+ ErlNifBinary data;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != SHA_CTX_LEN
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
- return enif_make_badarg(env);
+
+ if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx) ||
+ !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
+ return enif_make_badarg(env);
}
- new_ctx = (SHA_CTX*) enif_make_new_binary(env,SHA_CTX_LEN, &ret);
- memcpy(new_ctx, ctx_bin.data, SHA_CTX_LEN);
- SHA1_Update(new_ctx, data_bin.data, data_bin.size);
- CONSUME_REDS(env,data_bin);
+
+ new_ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(EVP_MD_CTX));
+ if (!EVP_MD_CTX_copy(new_ctx, ctx) ||
+ !EVP_DigestUpdate(new_ctx, data.data, data.size)) {
+ enif_release_resource(new_ctx);
+ return atom_notsup;
+ }
+
+ ret = enif_make_resource(env, new_ctx);
+ enif_release_resource(new_ctx);
+ CONSUME_REDS(env, data);
return ret;
}
-static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Context) */
- ErlNifBinary ctx_bin;
- SHA_CTX ctx_clone;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != SHA_CTX_LEN) {
- return enif_make_badarg(env);
+ EVP_MD_CTX *ctx, new_ctx;
+ ERL_NIF_TERM ret;
+ unsigned ret_size;
+
+ if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx)) {
+ return enif_make_badarg(env);
}
- memcpy(&ctx_clone, ctx_bin.data, SHA_CTX_LEN); /* writable */
- SHA1_Final(enif_make_new_binary(env, SHA_LEN, &ret), &ctx_clone);
- return ret;
-}
-static ERL_NIF_TERM sha224_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Data) */
-#ifdef HAVE_SHA224
- ErlNifBinary ibin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) {
- return enif_make_badarg(env);
+ ret_size = (unsigned)EVP_MD_CTX_size(ctx);
+ ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE);
+
+ if (!EVP_MD_CTX_copy(&new_ctx, ctx) ||
+ !EVP_DigestFinal(&new_ctx,
+ enif_make_new_binary(env, ret_size, &ret),
+ &ret_size)) {
+ return atom_notsup;
}
- SHA224((unsigned char *) ibin.data, ibin.size,
- enif_make_new_binary(env,SHA224_LEN, &ret));
- CONSUME_REDS(env,ibin);
+ ASSERT(ret_size == (unsigned)EVP_MD_CTX_size(ctx));
+
return ret;
-#else
- return atom_notsup;
-#endif
}
-static ERL_NIF_TERM sha224_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* () */
-#ifdef HAVE_SHA224
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- SHA224_Init((SHA256_CTX *) enif_make_new_binary(env, sizeof(SHA256_CTX), &ret));
- return ret;
-#else
- return atom_notsup;
-#endif
-}
-static ERL_NIF_TERM sha224_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context, Data) */
-#ifdef HAVE_SHA224
- SHA256_CTX* new_ctx;
- ErlNifBinary ctx_bin, data_bin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
+
+#else /* if OPENSSL_VERSION_NUMBER < 1.0 */
+
+static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Type) */
+ typedef int (*init_fun)(unsigned char*);
+ struct digest_type_t *digp = NULL;
+ ERL_NIF_TERM ctx;
+ size_t ctx_size = 0;
+ init_fun ctx_init = 0;
+
+ digp = get_digest_type(argv[0]);
+ if (!digp) {
return enif_make_badarg(env);
}
- new_ctx = (SHA256_CTX*) enif_make_new_binary(env,sizeof(SHA256_CTX), &ret);
- memcpy(new_ctx, ctx_bin.data, sizeof(SHA256_CTX));
- SHA224_Update(new_ctx, data_bin.data, data_bin.size);
- CONSUME_REDS(env,data_bin);
- return ret;
-#else
- return atom_notsup;
-#endif
-}
-static ERL_NIF_TERM sha224_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context) */
-#ifdef HAVE_SHA224
- ErlNifBinary ctx_bin;
- SHA256_CTX ctx_clone;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)) {
- return enif_make_badarg(env);
+ if (!digp->md_func) {
+ return atom_notsup;
}
- memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA256_CTX)); /* writable */
- SHA224_Final(enif_make_new_binary(env, SHA224_LEN, &ret), &ctx_clone);
- return ret;
-#else
- return atom_notsup;
-#endif
-}
-static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Data) */
-#ifdef HAVE_SHA256
- ErlNifBinary ibin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) {
- return enif_make_badarg(env);
- }
- SHA256((unsigned char *) ibin.data, ibin.size,
- enif_make_new_binary(env,SHA256_LEN, &ret));
- CONSUME_REDS(env,ibin);
- return ret;
-#else
- return atom_notsup;
+ switch (EVP_MD_type(digp->md_func()))
+ {
+ case NID_md4:
+ ctx_size = MD4_CTX_LEN;
+ ctx_init = (init_fun)(&MD4_Init);
+ break;
+ case NID_md5:
+ ctx_size = MD5_CTX_LEN;
+ ctx_init = (init_fun)(&MD5_Init);
+ break;
+ case NID_ripemd160:
+ ctx_size = RIPEMD160_CTX_LEN;
+ ctx_init = (init_fun)(&RIPEMD160_Init);
+ break;
+ case NID_sha1:
+ ctx_size = sizeof(SHA_CTX);
+ ctx_init = (init_fun)(&SHA1_Init);
+ break;
+#ifdef HAVE_SHA224
+ case NID_sha224:
+ ctx_size = sizeof(SHA256_CTX);
+ ctx_init = (init_fun)(&SHA224_Init);
+ break;
#endif
-}
-static ERL_NIF_TERM sha256_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* () */
#ifdef HAVE_SHA256
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- SHA256_Init((SHA256_CTX *) enif_make_new_binary(env, sizeof(SHA256_CTX), &ret));
- return ret;
-#else
- return atom_notsup;
+ case NID_sha256:
+ ctx_size = sizeof(SHA256_CTX);
+ ctx_init = (init_fun)(&SHA256_Init);
+ break;
#endif
-}
-static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context, Data) */
-#ifdef HAVE_SHA256
- SHA256_CTX* new_ctx;
- ErlNifBinary ctx_bin, data_bin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
- return enif_make_badarg(env);
+#ifdef HAVE_SHA384
+ case NID_sha384:
+ ctx_size = sizeof(SHA512_CTX);
+ ctx_init = (init_fun)(&SHA384_Init);
+ break;
+#endif
+#ifdef HAVE_SHA512
+ case NID_sha512:
+ ctx_size = sizeof(SHA512_CTX);
+ ctx_init = (init_fun)(&SHA512_Init);
+ break;
+#endif
+ default:
+ return atom_notsup;
+ }
+ ASSERT(ctx_size);
+ ASSERT(ctx_init);
+
+ ctx_init(enif_make_new_binary(env, ctx_size, &ctx));
+ return enif_make_tuple2(env, argv[0], ctx);
+}
+static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* ({Type, Context}, Data) */
+ typedef int (*update_fun)(unsigned char*, const unsigned char*, size_t);
+ ERL_NIF_TERM new_ctx;
+ ErlNifBinary ctx, data;
+ const ERL_NIF_TERM *tuple;
+ int arity;
+ struct digest_type_t *digp = NULL;
+ unsigned char *ctx_buff;
+ size_t ctx_size = 0;
+ update_fun ctx_update = 0;
+
+ if (!enif_get_tuple(env, argv[0], &arity, &tuple) ||
+ arity != 2 ||
+ !(digp = get_digest_type(tuple[0])) ||
+ !enif_inspect_binary(env, tuple[1], &ctx) ||
+ !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
+ return enif_make_badarg(env);
}
- new_ctx = (SHA256_CTX*) enif_make_new_binary(env,sizeof(SHA256_CTX), &ret);
- memcpy(new_ctx, ctx_bin.data, sizeof(SHA256_CTX));
- SHA256_Update(new_ctx, data_bin.data, data_bin.size);
- CONSUME_REDS(env,data_bin);
- return ret;
-#else
- return atom_notsup;
+ if (!digp->md_func) {
+ return atom_notsup;
+ }
+
+ switch (EVP_MD_type(digp->md_func()))
+ {
+ case NID_md4:
+ ctx_size = MD4_CTX_LEN;
+ ctx_update = (update_fun)(&MD4_Update);
+ break;
+ case NID_md5:
+ ctx_size = MD5_CTX_LEN;
+ ctx_update = (update_fun)(&MD5_Update);
+ break;
+ case NID_ripemd160:
+ ctx_size = RIPEMD160_CTX_LEN;
+ ctx_update = (update_fun)(&RIPEMD160_Update);
+ break;
+ case NID_sha1:
+ ctx_size = sizeof(SHA_CTX);
+ ctx_update = (update_fun)(&SHA1_Update);
+ break;
+#ifdef HAVE_SHA224
+ case NID_sha224:
+ ctx_size = sizeof(SHA256_CTX);
+ ctx_update = (update_fun)(&SHA224_Update);
+ break;
#endif
-}
-static ERL_NIF_TERM sha256_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context) */
#ifdef HAVE_SHA256
- ErlNifBinary ctx_bin;
- SHA256_CTX ctx_clone;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)) {
- return enif_make_badarg(env);
- }
- memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA256_CTX)); /* writable */
- SHA256_Final(enif_make_new_binary(env, SHA256_LEN, &ret), &ctx_clone);
- return ret;
-#else
- return atom_notsup;
+ case NID_sha256:
+ ctx_size = sizeof(SHA256_CTX);
+ ctx_update = (update_fun)(&SHA256_Update);
+ break;
#endif
-}
-
-static ERL_NIF_TERM sha384_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Data) */
#ifdef HAVE_SHA384
- ErlNifBinary ibin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) {
- return enif_make_badarg(env);
- }
- SHA384((unsigned char *) ibin.data, ibin.size,
- enif_make_new_binary(env,SHA384_LEN, &ret));
- CONSUME_REDS(env,ibin);
- return ret;
-#else
- return atom_notsup;
+ case NID_sha384:
+ ctx_size = sizeof(SHA512_CTX);
+ ctx_update = (update_fun)(&SHA384_Update);
+ break;
#endif
-}
-static ERL_NIF_TERM sha384_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* () */
-#ifdef HAVE_SHA384
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- SHA384_Init((SHA512_CTX *) enif_make_new_binary(env, sizeof(SHA512_CTX), &ret));
- return ret;
-#else
- return atom_notsup;
+#ifdef HAVE_SHA512
+ case NID_sha512:
+ ctx_size = sizeof(SHA512_CTX);
+ ctx_update = (update_fun)(&SHA512_Update);
+ break;
#endif
-}
-static ERL_NIF_TERM sha384_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context, Data) */
-#ifdef HAVE_SHA384
- SHA512_CTX* new_ctx;
- ErlNifBinary ctx_bin, data_bin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
- return enif_make_badarg(env);
+ default:
+ return atom_notsup;
}
- new_ctx = (SHA512_CTX*) enif_make_new_binary(env,sizeof(SHA512_CTX), &ret);
- memcpy(new_ctx, ctx_bin.data, sizeof(SHA512_CTX));
- SHA384_Update(new_ctx, data_bin.data, data_bin.size);
- CONSUME_REDS(env,data_bin);
- return ret;
-#else
- return atom_notsup;
-#endif
-}
-static ERL_NIF_TERM sha384_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context) */
-#ifdef HAVE_SHA384
- ErlNifBinary ctx_bin;
- SHA512_CTX ctx_clone;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)) {
- return enif_make_badarg(env);
+ ASSERT(ctx_size);
+ ASSERT(ctx_update);
+
+ if (ctx.size != ctx_size) {
+ return enif_make_badarg(env);
}
- memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA512_CTX)); /* writable */
- SHA384_Final(enif_make_new_binary(env, SHA384_LEN, &ret), &ctx_clone);
- return ret;
-#else
- return atom_notsup;
-#endif
-}
-static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Data) */
-#ifdef HAVE_SHA512
- ErlNifBinary ibin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) {
- return enif_make_badarg(env);
+ ctx_buff = enif_make_new_binary(env, ctx_size, &new_ctx);
+ memcpy(ctx_buff, ctx.data, ctx_size);
+ ctx_update(ctx_buff, data.data, data.size);
+
+ CONSUME_REDS(env, data);
+ return enif_make_tuple2(env, tuple[0], new_ctx);
+}
+static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* ({Type, Context}) */
+ typedef int (*final_fun)(unsigned char*, void*);
+ ERL_NIF_TERM ret;
+ ErlNifBinary ctx;
+ const ERL_NIF_TERM *tuple;
+ int arity;
+ struct digest_type_t *digp = NULL;
+ const EVP_MD *md;
+ void *new_ctx;
+ size_t ctx_size = 0;
+ final_fun ctx_final = 0;
+
+ if (!enif_get_tuple(env, argv[0], &arity, &tuple) ||
+ arity != 2 ||
+ !(digp = get_digest_type(tuple[0])) ||
+ !enif_inspect_binary(env, tuple[1], &ctx)) {
+ return enif_make_badarg(env);
}
- SHA512((unsigned char *) ibin.data, ibin.size,
- enif_make_new_binary(env,SHA512_LEN, &ret));
- CONSUME_REDS(env,ibin);
- return ret;
-#else
- return atom_notsup;
+ if (!digp->md_func) {
+ return atom_notsup;
+ }
+
+ md = digp->md_func();
+
+ switch (EVP_MD_type(md))
+ {
+ case NID_md4:
+ ctx_size = MD4_CTX_LEN;
+ ctx_final = (final_fun)(&MD4_Final);
+ break;
+ case NID_md5:
+ ctx_size = MD5_CTX_LEN;
+ ctx_final = (final_fun)(&MD5_Final);
+ break;
+ case NID_ripemd160:
+ ctx_size = RIPEMD160_CTX_LEN;
+ ctx_final = (final_fun)(&RIPEMD160_Final);
+ break;
+ case NID_sha1:
+ ctx_size = sizeof(SHA_CTX);
+ ctx_final = (final_fun)(&SHA1_Final);
+ break;
+#ifdef HAVE_SHA224
+ case NID_sha224:
+ ctx_size = sizeof(SHA256_CTX);
+ ctx_final = (final_fun)(&SHA224_Final);
+ break;
#endif
-}
-static ERL_NIF_TERM sha512_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* () */
-#ifdef HAVE_SHA512
- ERL_NIF_TERM ret;
- SHA512_Init((SHA512_CTX *) enif_make_new_binary(env, sizeof(SHA512_CTX), &ret));
- return ret;
-#else
- return atom_notsup;
+#ifdef HAVE_SHA256
+ case NID_sha256:
+ ctx_size = sizeof(SHA256_CTX);
+ ctx_final = (final_fun)(&SHA256_Final);
+ break;
#endif
-}
-static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context, Data) */
-#ifdef HAVE_SHA512
- SHA512_CTX* new_ctx;
- ErlNifBinary ctx_bin, data_bin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
- return enif_make_badarg(env);
- }
- new_ctx = (SHA512_CTX*) enif_make_new_binary(env,sizeof(SHA512_CTX), &ret);
- memcpy(new_ctx, ctx_bin.data, sizeof(SHA512_CTX));
- SHA512_Update(new_ctx, data_bin.data, data_bin.size);
- CONSUME_REDS(env,data_bin);
- return ret;
-#else
- return atom_notsup;
+#ifdef HAVE_SHA384
+ case NID_sha384:
+ ctx_size = sizeof(SHA512_CTX);
+ ctx_final = (final_fun)(&SHA384_Final);
+ break;
#endif
-}
-static ERL_NIF_TERM sha512_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context) */
#ifdef HAVE_SHA512
- ErlNifBinary ctx_bin;
- SHA512_CTX ctx_clone;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)) {
- return enif_make_badarg(env);
- }
- memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA512_CTX)); /* writable */
- SHA512_Final(enif_make_new_binary(env, SHA512_LEN, &ret), &ctx_clone);
- return ret;
-#else
- return atom_notsup;
+ case NID_sha512:
+ ctx_size = sizeof(SHA512_CTX);
+ ctx_final = (final_fun)(&SHA512_Final);
+ break;
#endif
-}
-
-
-static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Data) */
- ErlNifBinary ibin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) {
- return enif_make_badarg(env);
+ default:
+ return atom_notsup;
}
- MD4((unsigned char *) ibin.data, ibin.size,
- enif_make_new_binary(env,MD4_LEN, &ret));
- CONSUME_REDS(env,ibin);
- return ret;
-}
-static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* () */
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- MD4_Init((MD4_CTX *) enif_make_new_binary(env, MD4_CTX_LEN, &ret));
- return ret;
-}
-static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context, Data) */
- MD4_CTX* new_ctx;
- ErlNifBinary ctx_bin, data_bin;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD4_CTX_LEN
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
- return enif_make_badarg(env);
- }
- new_ctx = (MD4_CTX*) enif_make_new_binary(env,MD4_CTX_LEN, &ret);
- memcpy(new_ctx, ctx_bin.data, MD4_CTX_LEN);
- MD4_Update(new_ctx, data_bin.data, data_bin.size);
- CONSUME_REDS(env,data_bin);
- return ret;
-}
-static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Context) */
- ErlNifBinary ctx_bin;
- MD4_CTX ctx_clone;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD4_CTX_LEN) {
- return enif_make_badarg(env);
- }
- memcpy(&ctx_clone, ctx_bin.data, MD4_CTX_LEN); /* writable */
- MD4_Final(enif_make_new_binary(env, MD4_LEN, &ret), &ctx_clone);
- return ret;
-}
+ ASSERT(ctx_size);
+ ASSERT(ctx_final);
-static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Data, MacSize) */
- unsigned char hmacbuf[SHA_DIGEST_LENGTH];
- ErlNifBinary key, data;
- unsigned mac_sz;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data)
- || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > MD5_LEN) {
- return enif_make_badarg(env);
+ if (ctx.size != ctx_size) {
+ return enif_make_badarg(env);
}
- hmac_md5(key.data, key.size, data.data, data.size, hmacbuf);
- memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz);
- CONSUME_REDS(env,data);
- return ret;
-}
-static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Data, MacSize) */
- unsigned char hmacbuf[SHA_DIGEST_LENGTH];
- ErlNifBinary key, data;
- unsigned mac_sz;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data)
- || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA_LEN) {
- return enif_make_badarg(env);
- }
- hmac_sha1(key.data, key.size, data.data, data.size, hmacbuf);
- memcpy(enif_make_new_binary(env, mac_sz, &ret),
- hmacbuf, mac_sz);
- CONSUME_REDS(env,data);
- return ret;
-}
+ new_ctx = enif_alloc(ctx_size);
+ memcpy(new_ctx, ctx.data, ctx_size);
+ ctx_final(enif_make_new_binary(env, (size_t)EVP_MD_size(md), &ret),
+ new_ctx);
+ enif_free(new_ctx);
-static ERL_NIF_TERM sha224_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Data, MacSize) */
-#ifdef HAVE_SHA224
- unsigned char hmacbuf[SHA224_DIGEST_LENGTH];
- ErlNifBinary key, data;
- unsigned mac_sz;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data)
- || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA224_DIGEST_LENGTH) {
- return enif_make_badarg(env);
- }
- hmac_sha224(key.data, key.size, data.data, data.size, hmacbuf);
- memcpy(enif_make_new_binary(env, mac_sz, &ret),
- hmacbuf, mac_sz);
- CONSUME_REDS(env,data);
return ret;
-#else
- return atom_notsup;
-#endif
}
+#endif /* OPENSSL_VERSION_NUMBER < 1.0 */
-static ERL_NIF_TERM sha256_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Data, MacSize) */
-#ifdef HAVE_SHA256
- unsigned char hmacbuf[SHA256_DIGEST_LENGTH];
- ErlNifBinary key, data;
- unsigned mac_sz;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data)
- || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA256_DIGEST_LENGTH) {
- return enif_make_badarg(env);
- }
- hmac_sha256(key.data, key.size, data.data, data.size, hmacbuf);
- memcpy(enif_make_new_binary(env, mac_sz, &ret),
- hmacbuf, mac_sz);
- CONSUME_REDS(env,data);
- return ret;
-#else
- return atom_notsup;
-#endif
-}
+static ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Type, Key, Data) or (Type, Key, Data, MacSize) */
+ struct digest_type_t *digp = NULL;
+ ErlNifBinary key, data;
+ unsigned char buff[EVP_MAX_MD_SIZE];
+ unsigned size = 0, req_size = 0;
+ ERL_NIF_TERM ret;
-static ERL_NIF_TERM sha384_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Data, MacSize) */
-#ifdef HAVE_SHA384
- unsigned char hmacbuf[SHA384_DIGEST_LENGTH];
- ErlNifBinary key, data;
- unsigned mac_sz;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data)
- || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA384_DIGEST_LENGTH) {
- return enif_make_badarg(env);
+ digp = get_digest_type(argv[0]);
+ if (!digp ||
+ !enif_inspect_iolist_as_binary(env, argv[1], &key) ||
+ !enif_inspect_iolist_as_binary(env, argv[2], &data) ||
+ (argc == 4 && !enif_get_uint(env, argv[3], &req_size))) {
+ return enif_make_badarg(env);
}
- hmac_sha384(key.data, key.size, data.data, data.size, hmacbuf);
- memcpy(enif_make_new_binary(env, mac_sz, &ret),
- hmacbuf, mac_sz);
- CONSUME_REDS(env,data);
- return ret;
-#else
- return atom_notsup;
-#endif
-}
+ if (!digp->md_func ||
+ !HMAC(digp->md_func(),
+ key.data, key.size,
+ data.data, data.size,
+ buff, &size)) {
+ return atom_notsup;
+ }
+ ASSERT(0 < size && size <= EVP_MAX_MD_SIZE);
+ CONSUME_REDS(env, data);
-static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Data, MacSize) */
-#ifdef HAVE_SHA512
- unsigned char hmacbuf[SHA512_DIGEST_LENGTH];
- ErlNifBinary key, data;
- unsigned mac_sz;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data)
- || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA512_DIGEST_LENGTH) {
- return enif_make_badarg(env);
+ if (argc == 4) {
+ if (req_size <= size) {
+ size = req_size;
+ }
+ else {
+ return enif_make_badarg(env);
+ }
}
- hmac_sha512(key.data, key.size, data.data, data.size, hmacbuf);
- memcpy(enif_make_new_binary(env, mac_sz, &ret),
- hmacbuf, mac_sz);
- CONSUME_REDS(env,data);
+ memcpy(enif_make_new_binary(env, size, &ret), buff, size);
return ret;
-#else
- return atom_notsup;
-#endif
}
static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj)
@@ -1455,55 +1217,46 @@ static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj)
enif_mutex_destroy(obj->mtx);
}
-static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type, Key) */
- ErlNifBinary key;
- struct hmac_context* obj;
- const EVP_MD *md;
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
+ struct digest_type_t *digp = NULL;
+ ErlNifBinary key;
+ ERL_NIF_TERM ret;
+ struct hmac_context *obj;
- if (argv[0] == atom_sha) md = EVP_sha1();
-#ifdef HAVE_SHA224
- else if (argv[0] == atom_sha224) md = EVP_sha224();
-#endif
-#ifdef HAVE_SHA256
- else if (argv[0] == atom_sha256) md = EVP_sha256();
-#endif
-#ifdef HAVE_SHA384
- else if (argv[0] == atom_sha384) md = EVP_sha384();
-#endif
-#ifdef HAVE_SHA512
- else if (argv[0] == atom_sha512) md = EVP_sha512();
-#endif
- else if (argv[0] == atom_md5) md = EVP_md5();
- else if (argv[0] == atom_ripemd160) md = EVP_ripemd160();
- else goto badarg;
-
- if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) {
- badarg:
- return enif_make_badarg(env);
+ digp = get_digest_type(argv[0]);
+ if (!digp ||
+ !enif_inspect_iolist_as_binary(env, argv[1], &key)) {
+ return enif_make_badarg(env);
+ }
+ if (!digp->md_func) {
+ return atom_notsup;
}
obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context));
obj->mtx = enif_mutex_create("crypto.hmac");
obj->alive = 1;
- HMAC_CTX_init(&obj->ctx);
- HMAC_Init(&obj->ctx, key.data, key.size, md);
+#if OPENSSL_VERSION_NUMBER >= 0x1000000fL
+ // Check the return value of HMAC_Init: it may fail in FIPS mode
+ // for disabled algorithms
+ if (!HMAC_Init(&obj->ctx, key.data, key.size, digp->md_func())) {
+ enif_release_resource(obj);
+ return atom_notsup;
+ }
+#else
+ HMAC_Init(&obj->ctx, key.data, key.size, digp->md_func());
+#endif
ret = enif_make_resource(env, obj);
enif_release_resource(obj);
return ret;
}
-static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Context, Data) */
ErlNifBinary data;
struct hmac_context* obj;
- CHECK_OSE_CRYPTO();
-
if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj)
|| !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
return enif_make_badarg(env);
@@ -1520,7 +1273,7 @@ static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
return argv[0];
}
-static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Context) or (Context, HashLen) */
ERL_NIF_TERM ret;
struct hmac_context* obj;
@@ -1529,8 +1282,6 @@ static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
unsigned int req_len = 0;
unsigned int mac_len;
- CHECK_OSE_CRYPTO();
-
if (!enif_get_resource(env,argv[0],hmac_context_rtype, (void**)&obj)
|| (argc == 2 && !enif_get_uint(env, argv[1], &req_len))) {
return enif_make_badarg(env);
@@ -1557,206 +1308,197 @@ static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
return ret;
}
-static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Ivec, Text, IsEncrypt) */
- ErlNifBinary key, ivec, text;
- DES_key_schedule schedule;
- DES_cblock ivec_clone; /* writable copy */
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
+static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Type, Key, Ivec, Text, IsEncrypt) or (Type, Key, Text, IsEncrypt) */
+ struct cipher_type_t *cipherp = NULL;
+ const EVP_CIPHER *cipher;
+ ErlNifBinary key, ivec, text;
+ EVP_CIPHER_CTX ctx;
+ ERL_NIF_TERM ret;
+ unsigned char *out;
+ int ivec_size, out_size = 0;
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8
- || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[2], &text)
- || text.size % 8 != 0) {
- return enif_make_badarg(env);
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &key)
+ || !(cipherp = get_cipher_type(argv[0], key.size))
+ || !enif_inspect_iolist_as_binary(env, argv[argc - 2], &text)) {
+ return enif_make_badarg(env);
}
- memcpy(&ivec_clone, ivec.data, 8);
- DES_set_key((const_DES_cblock*)key.data, &schedule);
- DES_ncbc_encrypt(text.data, enif_make_new_binary(env, text.size, &ret),
- text.size, &schedule, &ivec_clone, (argv[3] == atom_true));
- CONSUME_REDS(env,text);
- return ret;
-}
-
-static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Ivec, Text, IsEncrypt) */
- ErlNifBinary key, ivec, text;
- DES_key_schedule schedule;
- DES_cblock ivec_clone; /* writable copy */
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8
- || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
- return enif_make_badarg(env);
+ if (!cipherp->cipher_func) {
+ return enif_raise_exception(env, atom_notsup);
}
- memcpy(&ivec_clone, ivec.data, 8);
- DES_set_key((const_DES_cblock*)key.data, &schedule);
- DES_cfb_encrypt(text.data, enif_make_new_binary(env, text.size, &ret),
- 8, text.size, &schedule, &ivec_clone, (argv[3] == atom_true));
- CONSUME_REDS(env,text);
- return ret;
-}
-static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Text/Cipher, IsEncrypt) */
- ErlNifBinary key, text;
- DES_key_schedule schedule;
- ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 ||
- !enif_inspect_iolist_as_binary(env, argv[1], &text) || text.size != 8) {
- return enif_make_badarg(env);
+ if ((argv[0] == atom_aes_cfb8 || argv[0] == atom_aes_cfb128)
+ && (key.size == 24 || key.size == 32)) {
+ /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes?
+ * Fall back on low level API
+ */
+ return aes_cfb_8_crypt(env, argc-1, argv+1);
}
- DES_set_key((const_DES_cblock*)key.data, &schedule);
- DES_ecb_encrypt((const_DES_cblock*)text.data,
- (DES_cblock*)enif_make_new_binary(env, 8, &ret),
- &schedule, (argv[2] == atom_true));
- CONSUME_REDS(env,text);
- return ret;
-}
-static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */
- ErlNifBinary key1, key2, key3, ivec, text;
- DES_key_schedule schedule1, schedule2, schedule3;
- DES_cblock ivec_clone; /* writable copy */
- ERL_NIF_TERM ret;
+ cipher = cipherp->cipher_func();
+ ivec_size = EVP_CIPHER_iv_length(cipher);
- CHECK_OSE_CRYPTO();
+#ifdef HAVE_ECB_IVEC_BUG
+ if (argv[0] == atom_aes_ecb || argv[0] == atom_blowfish_ecb ||
+ argv[0] == atom_des_ecb)
+ ivec_size = 0; /* 0.9.8l returns faulty ivec_size */
+#endif
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8
- || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[4], &text)
- || text.size % 8 != 0) {
- return enif_make_badarg(env);
+ if (text.size % EVP_CIPHER_block_size(cipher) != 0 ||
+ (ivec_size == 0 ? argc != 4
+ : (argc != 5 ||
+ !enif_inspect_iolist_as_binary(env, argv[2], &ivec) ||
+ ivec.size != ivec_size))) {
+ return enif_make_badarg(env);
}
- memcpy(&ivec_clone, ivec.data, 8);
- DES_set_key((const_DES_cblock*)key1.data, &schedule1);
- DES_set_key((const_DES_cblock*)key2.data, &schedule2);
- DES_set_key((const_DES_cblock*)key3.data, &schedule3);
- DES_ede3_cbc_encrypt(text.data, enif_make_new_binary(env,text.size,&ret),
- text.size, &schedule1, &schedule2, &schedule3,
- &ivec_clone, (argv[5] == atom_true));
- CONSUME_REDS(env,text);
- return ret;
-}
+ out = enif_make_new_binary(env, text.size, &ret);
-static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */
-#ifdef HAVE_DES_ede3_cfb_encrypt
- ErlNifBinary key1, key2, key3, ivec, text;
- DES_key_schedule schedule1, schedule2, schedule3;
- DES_cblock ivec_clone; /* writable copy */
- ERL_NIF_TERM ret;
+ EVP_CIPHER_CTX_init(&ctx);
+ if (!EVP_CipherInit_ex(&ctx, cipher, NULL, NULL, NULL,
+ (argv[argc - 1] == atom_true)) ||
+ !EVP_CIPHER_CTX_set_key_length(&ctx, key.size) ||
+ !(EVP_CIPHER_type(cipher) != NID_rc2_cbc ||
+ EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_SET_RC2_KEY_BITS, key.size * 8, NULL)) ||
+ !EVP_CipherInit_ex(&ctx, NULL, NULL,
+ key.data, ivec_size ? ivec.data : NULL, -1) ||
+ !EVP_CIPHER_CTX_set_padding(&ctx, 0)) {
- CHECK_OSE_CRYPTO();
+ EVP_CIPHER_CTX_cleanup(&ctx);
+ return enif_raise_exception(env, atom_notsup);
+ }
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8
- || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[4], &text)) {
- return enif_make_badarg(env);
+ if (text.size > 0 && /* OpenSSL 0.9.8h asserts text.size > 0 */
+ (!EVP_CipherUpdate(&ctx, out, &out_size, text.data, text.size)
+ || (ASSERT(out_size == text.size), 0)
+ || !EVP_CipherFinal_ex(&ctx, out + out_size, &out_size))) {
+
+ EVP_CIPHER_CTX_cleanup(&ctx);
+ return enif_raise_exception(env, atom_notsup);
}
+ ASSERT(out_size == 0);
+ EVP_CIPHER_CTX_cleanup(&ctx);
+ CONSUME_REDS(env, text);
- memcpy(&ivec_clone, ivec.data, 8);
- DES_set_key((const_DES_cblock*)key1.data, &schedule1);
- DES_set_key((const_DES_cblock*)key2.data, &schedule2);
- DES_set_key((const_DES_cblock*)key3.data, &schedule3);
- DES_ede3_cfb_encrypt(text.data, enif_make_new_binary(env,text.size,&ret),
- 8, text.size, &schedule1, &schedule2, &schedule3,
- &ivec_clone, (argv[5] == atom_true));
- CONSUME_REDS(env,text);
return ret;
-#else
- return atom_notsup;
-#endif
}
static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, IVec, Data, IsEncrypt) */
- ErlNifBinary key, ivec, text;
- AES_KEY aes_key;
- unsigned char ivec_clone[16]; /* writable copy */
- int new_ivlen = 0;
- ERL_NIF_TERM ret;
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !(key.size == 16 || key.size == 24 || key.size == 32)
- || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16
- || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
- return enif_make_badarg(env);
- }
-
- memcpy(ivec_clone, ivec.data, 16);
- AES_set_encrypt_key(key.data, key.size * 8, &aes_key);
- AES_cfb8_encrypt((unsigned char *) text.data,
- enif_make_new_binary(env, text.size, &ret),
- text.size, &aes_key, ivec_clone, &new_ivlen,
- (argv[3] == atom_true));
- CONSUME_REDS(env,text);
- return ret;
+{/* (Key, IVec, Data, IsEncrypt) */
+ ErlNifBinary key, ivec, text;
+ AES_KEY aes_key;
+ unsigned char ivec_clone[16]; /* writable copy */
+ int new_ivlen = 0;
+ ERL_NIF_TERM ret;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
+ || !(key.size == 16 || key.size == 24 || key.size == 32)
+ || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16
+ || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
+ return enif_make_badarg(env);
+ }
+
+ memcpy(ivec_clone, ivec.data, 16);
+ AES_set_encrypt_key(key.data, key.size * 8, &aes_key);
+ AES_cfb8_encrypt((unsigned char *) text.data,
+ enif_make_new_binary(env, text.size, &ret),
+ text.size, &aes_key, ivec_clone, &new_ivlen,
+ (argv[3] == atom_true));
+ CONSUME_REDS(env,text);
+ return ret;
}
-static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, IVec, Data, IsEncrypt) */
- ErlNifBinary key, ivec, text;
+static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key, IVec, Data, IsEncrypt) */
+#ifdef HAVE_AES_IGE
+ ErlNifBinary key_bin, ivec_bin, data_bin;
AES_KEY aes_key;
- unsigned char ivec_clone[16]; /* writable copy */
- int new_ivlen = 0;
+ unsigned char ivec[32];
+ int i;
+ unsigned char* ret_ptr;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
+ || (key_bin.size != 16 && key_bin.size != 32)
+ || !enif_inspect_binary(env, argv[1], &ivec_bin)
+ || ivec_bin.size != 32
+ || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)
+ || data_bin.size % 16 != 0) {
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !(key.size == 16 || key.size == 24 || key.size == 32)
- || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16
- || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
- return enif_make_badarg(env);
+ return enif_make_badarg(env);
}
- memcpy(ivec_clone, ivec.data, 16);
- AES_set_encrypt_key(key.data, key.size * 8, &aes_key);
- AES_cfb128_encrypt((unsigned char *) text.data,
- enif_make_new_binary(env, text.size, &ret),
- text.size, &aes_key, ivec_clone, &new_ivlen,
- (argv[3] == atom_true));
- CONSUME_REDS(env,text);
+ if (argv[3] == atom_true) {
+ i = AES_ENCRYPT;
+ AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key);
+ }
+ else {
+ i = AES_DECRYPT;
+ AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key);
+ }
+
+ ret_ptr = enif_make_new_binary(env, data_bin.size, &ret);
+ memcpy(ivec, ivec_bin.data, 32); /* writable copy */
+ AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i);
+ CONSUME_REDS(env,data_bin);
return ret;
+#else
+ return atom_notsup;
+#endif
}
/* Common for both encrypt and decrypt
*/
static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key, IVec, Data) */
- ErlNifBinary key, ivec, text;
- AES_KEY aes_key;
- unsigned char ivec_clone[16]; /* writable copy */
- unsigned char ecount_buf[AES_BLOCK_SIZE];
- unsigned int num = 0;
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
+ ErlNifBinary key, ivec, text;
+#ifdef HAVE_EVP_AES_CTR
+ const EVP_CIPHER *cipher;
+ EVP_CIPHER_CTX ctx;
+ unsigned char *out;
+ int outl = 0;
+#else
+ AES_KEY aes_key;
+ unsigned char ivec_clone[16]; /* writable copy */
+ unsigned char ecount_buf[AES_BLOCK_SIZE];
+ unsigned int num = 0;
+#endif
+ ERL_NIF_TERM ret;
if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
+#ifndef HAVE_EVP_AES_CTR
|| AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0
+#endif
|| !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16
|| !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
return enif_make_badarg(env);
}
+#ifdef HAVE_EVP_AES_CTR
+ switch (key.size)
+ {
+ case 16: cipher = EVP_aes_128_ctr(); break;
+ case 24: cipher = EVP_aes_192_ctr(); break;
+ case 32: cipher = EVP_aes_256_ctr(); break;
+ default: return enif_make_badarg(env);
+ }
+
+ out = enif_make_new_binary(env,text.size,&ret);
+ EVP_CIPHER_CTX_init(&ctx);
+ EVP_CipherInit_ex(&ctx, cipher, NULL,
+ key.data, ivec.data, (argv[3] == atom_true));
+ EVP_CIPHER_CTX_set_padding(&ctx, 0);
+ EVP_CipherUpdate(&ctx, out, &outl, text.data, text.size);
+ ASSERT(outl == text.size);
+ EVP_CipherFinal_ex(&ctx, out + outl, &outl);
+ ASSERT(outl == 0);
+ EVP_CIPHER_CTX_cleanup(&ctx);
+#else
memcpy(ivec_clone, ivec.data, 16);
memset(ecount_buf, 0, sizeof(ecount_buf));
AES_ctr128_encrypt((unsigned char *) text.data,
enif_make_new_binary(env, text.size, &ret),
text.size, &aes_key, ivec_clone, ecount_buf, &num);
+#endif
CONSUME_REDS(env,text);
/* To do an incremental {en|de}cryption, the state to to keep between calls
@@ -1766,6 +1508,81 @@ static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM
/* Initializes state for ctr streaming (de)encryption
*/
+#ifdef HAVE_EVP_AES_CTR
+static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key, IVec) */
+ ErlNifBinary key_bin, ivec_bin;
+ EVP_CIPHER_CTX *ctx;
+ const EVP_CIPHER *cipher;
+ ERL_NIF_TERM ret;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
+ || !enif_inspect_binary(env, argv[1], &ivec_bin)
+ || ivec_bin.size != 16) {
+ return enif_make_badarg(env);
+ }
+
+ switch (key_bin.size)
+ {
+ case 16: cipher = EVP_aes_128_ctr(); break;
+ case 24: cipher = EVP_aes_192_ctr(); break;
+ case 32: cipher = EVP_aes_256_ctr(); break;
+ default: return enif_make_badarg(env);
+ }
+
+ ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(EVP_CIPHER_CTX));
+ EVP_CIPHER_CTX_init(ctx);
+ EVP_CipherInit_ex(ctx, cipher, NULL,
+ key_bin.data, ivec_bin.data, 1);
+ EVP_CIPHER_CTX_set_padding(ctx, 0);
+ ret = enif_make_resource(env, ctx);
+ enif_release_resource(ctx);
+ return ret;
+}
+static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Context, Data) */
+ EVP_CIPHER_CTX *ctx, *new_ctx;
+ ErlNifBinary data_bin;
+ ERL_NIF_TERM ret, cipher_term;
+ unsigned char *out;
+ int outl = 0;
+
+ if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)
+ || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
+ return enif_make_badarg(env);
+ }
+ new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(EVP_CIPHER_CTX));
+ EVP_CIPHER_CTX_init(new_ctx);
+ EVP_CIPHER_CTX_copy(new_ctx, ctx);
+ out = enif_make_new_binary(env, data_bin.size, &cipher_term);
+ EVP_CipherUpdate(new_ctx, out, &outl, data_bin.data, data_bin.size);
+ ASSERT(outl == data_bin.size);
+
+ ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term);
+ enif_release_resource(new_ctx);
+ CONSUME_REDS(env,data_bin);
+ return ret;
+}
+
+#else /* if not HAVE_EVP_AES_CTR */
+
+static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key, IVec) */
+ ErlNifBinary key_bin, ivec_bin;
+ ERL_NIF_TERM ecount_bin;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
+ || !enif_inspect_binary(env, argv[1], &ivec_bin)
+ || !(key_bin.size == 16 || key_bin.size == 24 || key_bin.size ==32)
+ || ivec_bin.size != 16) {
+ return enif_make_badarg(env);
+ }
+
+ memset(enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin),
+ 0, AES_BLOCK_SIZE);
+ return enif_make_tuple4(env, argv[0], argv[1], ecount_bin, enif_make_int(env, 0));
+}
+
static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* ({Key, IVec, ECount, Num}, Data) */
ErlNifBinary key_bin, ivec_bin, text_bin, ecount_bin;
@@ -1777,8 +1594,6 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N
unsigned char * ivec2_buf;
unsigned char * ecount2_buf;
- CHECK_OSE_CRYPTO();
-
if (!enif_get_tuple(env, argv[0], &state_arity, &state_term)
|| state_arity != 4
|| !enif_inspect_iolist_as_binary(env, state_term[0], &key_bin)
@@ -1806,70 +1621,86 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N
CONSUME_REDS(env,text_bin);
return ret;
}
+#endif /* !HAVE_EVP_AES_CTR */
static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key,Iv,AAD,In) */
#if defined(HAVE_GCM)
- GCM128_CONTEXT *ctx = NULL;
+ EVP_CIPHER_CTX ctx;
+ const EVP_CIPHER *cipher = NULL;
ErlNifBinary key, iv, aad, in;
- AES_KEY aes_key;
- unsigned char *outp;
+ unsigned char *outp, *tagp;
ERL_NIF_TERM out, out_tag;
-
- CHECK_OSE_CRYPTO();
+ int len;
if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0
+ || (key.size != 16 && key.size != 24 && key.size != 32)
|| !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0
|| !enif_inspect_iolist_as_binary(env, argv[2], &aad)
|| !enif_inspect_iolist_as_binary(env, argv[3], &in)) {
return enif_make_badarg(env);
}
- if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt)))
- return atom_error;
+ if (key.size == 16)
+ cipher = EVP_aes_128_gcm();
+ else if (key.size == 24)
+ cipher = EVP_aes_192_gcm();
+ else if (key.size == 32)
+ cipher = EVP_aes_256_gcm();
- CRYPTO_gcm128_setiv(ctx, iv.data, iv.size);
+ EVP_CIPHER_CTX_init(&ctx);
- if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size))
- goto out_err;
+ if (EVP_EncryptInit_ex(&ctx, cipher, NULL, NULL, NULL) != 1)
+ goto out_err;
+
+ EVP_CIPHER_CTX_set_padding(&ctx, 0);
+
+ if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1)
+ goto out_err;
+ if (EVP_EncryptInit_ex(&ctx, NULL, NULL, key.data, iv.data) != 1)
+ goto out_err;
+ if (EVP_EncryptUpdate(&ctx, NULL, &len, aad.data, aad.size) != 1)
+ goto out_err;
outp = enif_make_new_binary(env, in.size, &out);
- /* encrypt */
- if (CRYPTO_gcm128_encrypt(ctx, in.data, outp, in.size))
- goto out_err;
+ if (EVP_EncryptUpdate(&ctx, outp, &len, in.data, in.size) != 1)
+ goto out_err;
+ if (EVP_EncryptFinal_ex(&ctx, outp+len, &len) != 1)
+ goto out_err;
+
+ tagp = enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag);
- /* calculate the tag */
- CRYPTO_gcm128_tag(ctx, enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag), EVP_GCM_TLS_TAG_LEN);
- CRYPTO_gcm128_release(ctx);
+ if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_GET_TAG, EVP_GCM_TLS_TAG_LEN, tagp) != 1)
+ goto out_err;
+
+ EVP_CIPHER_CTX_cleanup(&ctx);
CONSUME_REDS(env, in);
return enif_make_tuple2(env, out, out_tag);
out_err:
- CRYPTO_gcm128_release(ctx);
+ EVP_CIPHER_CTX_cleanup(&ctx);
return atom_error;
#else
- return atom_notsup;
+ return enif_raise_exception(env, atom_notsup);
#endif
}
static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key,Iv,AAD,In,Tag) */
#if defined(HAVE_GCM)
- GCM128_CONTEXT *ctx;
+ EVP_CIPHER_CTX ctx;
+ const EVP_CIPHER *cipher = NULL;
ErlNifBinary key, iv, aad, in, tag;
- AES_KEY aes_key;
unsigned char *outp;
ERL_NIF_TERM out;
-
- CHECK_OSE_CRYPTO();
+ int len;
if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0
+ || (key.size != 16 && key.size != 24 && key.size != 32)
|| !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0
|| !enif_inspect_iolist_as_binary(env, argv[2], &aad)
|| !enif_inspect_iolist_as_binary(env, argv[3], &in)
@@ -1877,34 +1708,45 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM
return enif_make_badarg(env);
}
- if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt)))
- return atom_error;
+ if (key.size == 16)
+ cipher = EVP_aes_128_gcm();
+ else if (key.size == 24)
+ cipher = EVP_aes_192_gcm();
+ else if (key.size == 32)
+ cipher = EVP_aes_256_gcm();
- CRYPTO_gcm128_setiv(ctx, iv.data, iv.size);
+ EVP_CIPHER_CTX_init(&ctx);
- if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size))
- goto out_err;
+ if (EVP_DecryptInit_ex(&ctx, cipher, NULL, NULL, NULL) != 1)
+ goto out_err;
+ if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1)
+ goto out_err;
+ if (EVP_DecryptInit_ex(&ctx, NULL, NULL, key.data, iv.data) != 1)
+ goto out_err;
+ if (EVP_DecryptUpdate(&ctx, NULL, &len, aad.data, aad.size) != 1)
+ goto out_err;
outp = enif_make_new_binary(env, in.size, &out);
- /* decrypt */
- if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size))
- goto out_err;
+ if (EVP_DecryptUpdate(&ctx, outp, &len, in.data, in.size) != 1)
+ goto out_err;
+ if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_TAG, EVP_GCM_TLS_TAG_LEN, tag.data) != 1)
+ goto out_err;
+ if (EVP_DecryptFinal_ex(&ctx, outp+len, &len) != 1)
+ goto out_err;
- /* calculate and check the tag */
- if (CRYPTO_gcm128_finish(ctx, tag.data, EVP_GCM_TLS_TAG_LEN))
- goto out_err;
+ EVP_CIPHER_CTX_cleanup(&ctx);
- CRYPTO_gcm128_release(ctx);
CONSUME_REDS(env, in);
return out;
out_err:
- CRYPTO_gcm128_release(ctx);
+ EVP_CIPHER_CTX_cleanup(&ctx);
return atom_error;
+
#else
- return atom_notsup;
+ return enif_raise_exception(env, atom_notsup);
#endif
}
@@ -1937,8 +1779,6 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER
unsigned char poly1305_key[32];
poly1305_state poly1305;
- CHECK_OSE_CRYPTO();
-
if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32
|| !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN
|| !enif_inspect_iolist_as_binary(env, argv[2], &aad)
@@ -1976,7 +1816,7 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER
return enif_make_tuple2(env, out, out_tag);
#else
- return atom_notsup;
+ return enif_raise_exception(env, atom_notsup);
#endif
}
@@ -1991,8 +1831,6 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER
unsigned char mac[POLY1305_TAG_LEN];
poly1305_state poly1305;
- CHECK_OSE_CRYPTO();
-
if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32
|| !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN
|| !enif_inspect_iolist_as_binary(env, argv[2], &aad)
@@ -2033,51 +1871,16 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER
return out;
#else
- return atom_notsup;
+ return enif_raise_exception(env, atom_notsup);
#endif
}
-static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Data, IsEncrypt) */
- ErlNifBinary key_bin, data_bin;
- AES_KEY aes_key;
- int i;
- int j;
- unsigned char* ret_ptr;
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || (key_bin.size != 16 && key_bin.size != 32)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)
- || data_bin.size % 16 != 0) {
- return enif_make_badarg(env);
- }
-
- if (argv[2] == atom_true) {
- i = AES_ENCRYPT;
- AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key);
- }
- else {
- i = AES_DECRYPT;
- AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key);
- }
-
- ret_ptr = enif_make_new_binary(env, data_bin.size, &ret);
- for (j = 0; j < data_bin.size; j += 16) {
- AES_ecb_encrypt(data_bin.data+j, ret_ptr+j, &aes_key, i);
- }
- CONSUME_REDS(env,data_bin);
- return ret;
-}
-
static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Bytes) */
unsigned bytes;
unsigned char* data;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
+
if (!enif_get_uint(env, argv[0], &bytes)) {
return enif_make_badarg(env);
}
@@ -2091,7 +1894,7 @@ static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NI
unsigned bytes;
unsigned char* data;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
+
if (!enif_get_uint(env, argv[0], &bytes)) {
return enif_make_badarg(env);
}
@@ -2109,7 +1912,7 @@ static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
unsigned char* data;
unsigned top_mask, bot_mask;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
+
if (!enif_get_uint(env, argv[0], &bytes)
|| !enif_get_uint(env, argv[1], &top_mask)
|| !enif_get_uint(env, argv[2], &bot_mask)) {
@@ -2133,8 +1936,6 @@ static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NI
unsigned dlen;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
-
if (!enif_get_uint(env, argv[0], &bits)
|| !enif_get_int(env, argv[1], &top)
|| !enif_get_int(env, argv[2], &bottom)) {
@@ -2203,8 +2004,6 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER
unsigned dlen;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
-
if (!get_bn_from_mpint(env, argv[0], &bn_from)
|| !get_bn_from_mpint(env, argv[1], &bn_rand)) {
if (bn_from) BN_free(bn_from);
@@ -2236,8 +2035,6 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
unsigned extra_byte;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
-
if (!get_bn_from_bin(env, argv[0], &bn_base)
|| !get_bn_from_bin(env, argv[1], &bn_exponent)
|| !get_bn_from_bin(env, argv[2], &bn_modulo)
@@ -2269,46 +2066,17 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
}
static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (DigestType|none, Data|{digest,Digest}, Signature,Key=[P, Q, G, Y]) */
- ErlNifBinary data_bin, sign_bin;
+{/* (sha, Digest, Signature,Key=[P, Q, G, Y]) */
+ ErlNifBinary digest_bin, sign_bin;
BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL;
- unsigned char hmacbuf[SHA_DIGEST_LENGTH];
- unsigned char* digest;
ERL_NIF_TERM head, tail;
- const ERL_NIF_TERM* tpl_terms;
- int tpl_arity;
DSA *dsa;
int i;
- CHECK_OSE_CRYPTO();
-
- if (argv[0] == atom_sha) {
- if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) {
- if (tpl_arity != 2 || tpl_terms[0] != atom_digest
- || !enif_inspect_binary(env, tpl_terms[1], &data_bin)
- || data_bin.size != SHA_DIGEST_LENGTH) {
-
- return enif_make_badarg(env);
- }
- digest = data_bin.data;
- }
- else {
- if (!enif_inspect_binary(env, argv[1], &data_bin)) {
- return enif_make_badarg(env);
- }
- SHA1(data_bin.data, data_bin.size, hmacbuf);
- digest = hmacbuf;
- }
- }
- else if (argv[0] == atom_none && enif_inspect_binary(env, argv[1], &data_bin)
- && data_bin.size == SHA_DIGEST_LENGTH) {
- digest = data_bin.data;
- }
- else {
- return enif_make_badarg(env);
- }
-
- if (!enif_inspect_binary(env, argv[2], &sign_bin)
+ if (!argv[0] == atom_sha
+ || !enif_inspect_binary(env, argv[1], &digest_bin)
+ || digest_bin.size != SHA_DIGEST_LENGTH
+ || !enif_inspect_binary(env, argv[2], &sign_bin)
|| !enif_get_list_cell(env, argv[3], &head, &tail)
|| !get_bn_from_bin(env, head, &dsa_p)
|| !enif_get_list_cell(env, tail, &head, &tail)
@@ -2332,94 +2100,27 @@ static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
dsa->g = dsa_g;
dsa->priv_key = NULL;
dsa->pub_key = dsa_y;
- i = DSA_verify(0, digest, SHA_DIGEST_LENGTH,
+ i = DSA_verify(0, digest_bin.data, SHA_DIGEST_LENGTH,
sign_bin.data, sign_bin.size, dsa);
DSA_free(dsa);
return(i > 0) ? atom_true : atom_false;
}
-
-static void md5_digest(unsigned char* in, unsigned int in_len, unsigned char* out)
-{
- MD5(in, in_len, out);
-}
-static void sha1_digest(unsigned char* in, unsigned int in_len, unsigned char* out)
-{
- SHA1(in, in_len, out);
-}
-#ifdef HAVE_SHA224
-static void sha224_digest(unsigned char* in, unsigned int in_len, unsigned char* out)
-{
- SHA224(in, in_len, out);
-}
-#endif
-#ifdef HAVE_SHA256
-static void sha256_digest(unsigned char* in, unsigned int in_len, unsigned char* out)
-{
- SHA256(in, in_len, out);
-}
-#endif
-#ifdef HAVE_SHA384
-static void sha384_digest(unsigned char* in, unsigned int in_len, unsigned char* out)
-{
- SHA384(in, in_len, out);
-}
-#endif
-#ifdef HAVE_SHA512
-static void sha512_digest(unsigned char* in, unsigned int in_len, unsigned char* out)
+static void init_digest_types(ErlNifEnv* env)
{
- SHA512(in, in_len, out);
-}
-#endif
+ struct digest_type_t* p = digest_types;
-struct digest_type_t {
- const char* type_str;
- unsigned len; /* 0 if notsup */
- int NID_type;
- void (*funcp)(unsigned char* in, unsigned int in_len, unsigned char* out);
- ERL_NIF_TERM type_atom;
-};
+ for (p = digest_types; p->type_str; p++) {
+ p->type_atom = enif_make_atom(env, p->type_str);
+ }
-struct digest_type_t digest_types[] =
-{
- {"md5", MD5_DIGEST_LENGTH, NID_md5, md5_digest},
- {"sha", SHA_DIGEST_LENGTH, NID_sha1, sha1_digest},
- {"sha224",
-#ifdef HAVE_SHA224
- SHA224_LEN, NID_sha224, sha224_digest
-#else
- 0
-#endif
- },
- {"sha256",
-#ifdef HAVE_SHA256
- SHA256_LEN, NID_sha256, sha256_digest
-#else
- 0
-#endif
- },
- {"sha384",
-#ifdef HAVE_SHA384
- SHA384_LEN, NID_sha384, sha384_digest
-#else
- 0
-#endif
- },
- {"sha512",
-#ifdef HAVE_SHA512
- SHA512_LEN, NID_sha512, sha512_digest
-#else
- 0
-#endif
- },
- {NULL}
-};
+}
-static void init_digest_types(ErlNifEnv* env)
+static void init_cipher_types(ErlNifEnv* env)
{
- struct digest_type_t* p = digest_types;
+ struct cipher_type_t* p = cipher_types;
- for (p = digest_types; p->type_str; p++) {
+ for (p = cipher_types; p->type_str; p++) {
p->type_atom = enif_make_atom(env, p->type_str);
}
@@ -2436,32 +2137,45 @@ static struct digest_type_t* get_digest_type(ERL_NIF_TERM type)
return NULL;
}
-static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Data|{digest,Digest}, Signature, Key=[E,N]) */
- ErlNifBinary data_bin, sign_bin;
- unsigned char hmacbuf[SHA512_LEN];
- ERL_NIF_TERM head, tail, ret;
- int i;
- RSA* rsa;
- const ERL_NIF_TERM type = argv[0];
- const ERL_NIF_TERM* tpl_terms;
- int tpl_arity;
- struct digest_type_t* digp = NULL;
- unsigned char* digest = NULL;
+static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len)
+{
+ struct cipher_type_t* p = NULL;
+ for (p = cipher_types; p->type_str; p++) {
+ if (type == p->type_atom && (!p->key_len || key_len == p->key_len)) {
+ return p;
+ }
+ }
+ return NULL;
+}
- CHECK_OSE_CRYPTO();
+static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Type, Digest, Signature, Key=[E,N]) */
+ ErlNifBinary digest_bin, sign_bin;
+ ERL_NIF_TERM head, tail, ret;
+ int i;
+ RSA *rsa;
+#if OPENSSL_VERSION_NUMBER >= 0x1000000fL
+ EVP_PKEY *pkey;
+ EVP_PKEY_CTX *ctx;
+#endif
+ const EVP_MD *md;
+ const ERL_NIF_TERM type = argv[0];
+ struct digest_type_t *digp = NULL;
digp = get_digest_type(type);
if (!digp) {
return enif_make_badarg(env);
}
- if (!digp->len) {
+ if (!digp->md_func) {
return atom_notsup;
}
rsa = RSA_new();
+ md = digp->md_func();
- if (!enif_inspect_binary(env, argv[2], &sign_bin)
+ if (!enif_inspect_binary(env, argv[1], &digest_bin)
+ || digest_bin.size != EVP_MD_size(md)
+ || !enif_inspect_binary(env, argv[2], &sign_bin)
|| !enif_get_list_cell(env, argv[3], &head, &tail)
|| !get_bn_from_bin(env, head, &rsa->e)
|| !enif_get_list_cell(env, tail, &head, &tail)
@@ -2471,27 +2185,24 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
ret = enif_make_badarg(env);
goto done;
}
- if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) {
- if (tpl_arity != 2 || tpl_terms[0] != atom_digest
- || !enif_inspect_binary(env, tpl_terms[1], &data_bin)
- || data_bin.size != digp->len) {
- ret = enif_make_badarg(env);
- goto done;
- }
- digest = data_bin.data;
- }
- else if (enif_inspect_binary(env, argv[1], &data_bin)) {
- digest = hmacbuf;
- digp->funcp(data_bin.data, data_bin.size, digest);
- }
- else {
- ret = enif_make_badarg(env);
- goto done;
- }
-
- i = RSA_verify(digp->NID_type, digest, digp->len,
+#if OPENSSL_VERSION_NUMBER >= 0x1000000fL
+ pkey = EVP_PKEY_new();
+ EVP_PKEY_set1_RSA(pkey, rsa);
+
+ ctx = EVP_PKEY_CTX_new(pkey, NULL);
+ EVP_PKEY_verify_init(ctx);
+ EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING);
+ EVP_PKEY_CTX_set_signature_md(ctx, md);
+
+ i = EVP_PKEY_verify(ctx, sign_bin.data, sign_bin.size,
+ digest_bin.data, digest_bin.size);
+ EVP_PKEY_CTX_free(ctx);
+ EVP_PKEY_free(pkey);
+#else
+ i = RSA_verify(md->type, digest_bin.data, EVP_MD_size(md),
sign_bin.data, sign_bin.size, rsa);
+#endif
ret = (i==1 ? atom_true : atom_false);
@@ -2500,109 +2211,6 @@ done:
return ret;
}
-
-static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, IVec, Data, IsEncrypt) */
- ErlNifBinary key_bin, ivec_bin, data_bin;
- unsigned char ivec[16];
- int enc, i = 0, outlen = 0;
- EVP_CIPHER_CTX ctx;
- const EVP_CIPHER *cipher = NULL;
- unsigned char* ret_ptr;
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || (key_bin.size != 16 && key_bin.size != 32)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || ivec_bin.size != 16
- || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)
- || data_bin.size % 16 != 0) {
-
- return enif_make_badarg(env);
- }
-
- if (argv[3] == atom_true)
- enc = 1;
- else
- enc = 0;
-
- EVP_CIPHER_CTX_init(&ctx);
-
- if (key_bin.size == 16)
- cipher = EVP_aes_128_cbc();
- else if (key_bin.size == 32)
- cipher = EVP_aes_256_cbc();
-
- memcpy(ivec, ivec_bin.data, 16); /* writeable copy */
-
- /* openssl docs say we need to leave at least 3 blocks available
- at the end of the buffer for EVP calls. let's be safe */
- ret_ptr = enif_make_new_binary(env, data_bin.size + 16*3, &ret);
-
- if (EVP_CipherInit_ex(&ctx, cipher, NULL, key_bin.data, ivec, enc) != 1)
- return enif_make_badarg(env);
-
- /* disable padding, we only handle whole blocks */
- EVP_CIPHER_CTX_set_padding(&ctx, 0);
-
- if (EVP_CipherUpdate(&ctx, ret_ptr, &i, data_bin.data, data_bin.size) != 1)
- return enif_make_badarg(env);
- outlen += i;
- if (EVP_CipherFinal_ex(&ctx, ret_ptr + outlen, &i) != 1)
- return enif_make_badarg(env);
- outlen += i;
-
- EVP_CIPHER_CTX_cleanup(&ctx);
-
- CONSUME_REDS(env,data_bin);
-
- /* the garbage collector is going to love this */
- return enif_make_sub_binary(env, ret, 0, outlen);
-}
-
-static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, IVec, Data, IsEncrypt) */
-#ifdef HAVE_AES_IGE
- ErlNifBinary key_bin, ivec_bin, data_bin;
- AES_KEY aes_key;
- unsigned char ivec[32];
- int i;
- unsigned char* ret_ptr;
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || (key_bin.size != 16 && key_bin.size != 32)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || ivec_bin.size != 32
- || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)
- || data_bin.size % 16 != 0) {
-
- return enif_make_badarg(env);
- }
-
- if (argv[3] == atom_true) {
- i = AES_ENCRYPT;
- AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key);
- }
- else {
- i = AES_DECRYPT;
- AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key);
- }
-
- ret_ptr = enif_make_new_binary(env, data_bin.size, &ret);
- memcpy(ivec, ivec_bin.data, 32); /* writable copy */
- AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i);
- CONSUME_REDS(env,data_bin);
- return ret;
-#else
- return atom_notsup;
-#endif
-}
-
static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Data1, Data2) */
ErlNifBinary d1, d2;
@@ -2610,8 +2218,6 @@ static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
int i;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
-
if (!enif_inspect_iolist_as_binary(env,argv[0], &d1)
|| !enif_inspect_iolist_as_binary(env,argv[1], &d2)
|| d1.size != d2.size) {
@@ -2632,8 +2238,6 @@ static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
RC4_KEY rc4_key;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
-
if (!enif_inspect_iolist_as_binary(env,argv[0], &key)
|| !enif_inspect_iolist_as_binary(env,argv[1], &data)) {
return enif_make_badarg(env);
@@ -2650,8 +2254,6 @@ static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
ErlNifBinary key;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
-
if (!enif_inspect_iolist_as_binary(env,argv[0], &key)) {
return enif_make_badarg(env);
}
@@ -2667,8 +2269,6 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N
RC4_KEY* rc4_key;
ERL_NIF_TERM new_state, new_data;
- CHECK_OSE_CRYPTO();
-
if (!enif_inspect_iolist_as_binary(env,argv[0], &state)
|| state.size != sizeof(RC4_KEY)
|| !enif_inspect_iolist_as_binary(env,argv[1], &data)) {
@@ -2682,35 +2282,6 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N
return enif_make_tuple2(env,new_state,new_data);
}
-static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key,IVec,Data,IsEncrypt) */
- ErlNifBinary key_bin, ivec_bin, data_bin;
- RC2_KEY rc2_key;
- ERL_NIF_TERM ret;
- unsigned char iv_copy[8];
-
- CHECK_OSE_CRYPTO();
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || (key_bin.size != 5 && key_bin.size != 8 && key_bin.size != 16)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || ivec_bin.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)
- || data_bin.size % 8 != 0) {
- return enif_make_badarg(env);
- }
-
- RC2_set_key(&rc2_key, key_bin.size, key_bin.data, key_bin.size*8);
- memcpy(iv_copy, ivec_bin.data, 8);
- RC2_cbc_encrypt(data_bin.data,
- enif_make_new_binary(env, data_bin.size, &ret),
- data_bin.size, &rc2_key,
- iv_copy,
- (argv[3] == atom_true));
- CONSUME_REDS(env,data_bin);
- return ret;
-}
-
static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa)
{
/* key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C] */
@@ -2740,42 +2311,32 @@ static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa)
}
static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Data|{digest,Digest}, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */
- ErlNifBinary data_bin, ret_bin;
- unsigned char hmacbuf[SHA512_LEN];
- unsigned rsa_s_len;
- RSA* rsa;
- int i;
- const ERL_NIF_TERM* tpl_terms;
- int tpl_arity;
+{/* (Type, Digest, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */
+ ErlNifBinary digest_bin, ret_bin;
+#if OPENSSL_VERSION_NUMBER >= 0x1000000fL
+ EVP_PKEY *pkey;
+ EVP_PKEY_CTX *ctx;
+ size_t rsa_s_len;
+#else
+ unsigned rsa_s_len, len;
+#endif
+ RSA *rsa;
+ int i;
struct digest_type_t *digp;
- unsigned char* digest;
-
- CHECK_OSE_CRYPTO();
+ const EVP_MD *md;
digp = get_digest_type(argv[0]);
if (!digp) {
return enif_make_badarg(env);
}
- if (!digp->len) {
+ if (!digp->md_func) {
return atom_notsup;
}
+ md = digp->md_func();
- if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) {
- if (tpl_arity != 2 || tpl_terms[0] != atom_digest
- || !enif_inspect_binary(env, tpl_terms[1], &data_bin)
- || data_bin.size != digp->len) {
-
- return enif_make_badarg(env);
- }
- digest = data_bin.data;
- }
- else {
- if (!enif_inspect_binary(env,argv[1],&data_bin)) {
- return enif_make_badarg(env);
- }
- digest = hmacbuf;
- digp->funcp(data_bin.data, data_bin.size, digest);
+ if (!enif_inspect_binary(env,argv[1],&digest_bin)
+ || digest_bin.size != EVP_MD_size(md)) {
+ return enif_make_badarg(env);
}
rsa = RSA_new();
@@ -2785,14 +2346,33 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
}
+#if OPENSSL_VERSION_NUMBER >= 0x1000000fL
+ pkey = EVP_PKEY_new();
+ EVP_PKEY_set1_RSA(pkey, rsa);
+ rsa_s_len=(size_t)EVP_PKEY_size(pkey);
+ enif_alloc_binary(rsa_s_len, &ret_bin);
+
+ ctx = EVP_PKEY_CTX_new(pkey, NULL);
+ EVP_PKEY_sign_init(ctx);
+ EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING);
+ EVP_PKEY_CTX_set_signature_md(ctx, md);
+
+ i = EVP_PKEY_sign(ctx, ret_bin.data, &rsa_s_len,
+ digest_bin.data, digest_bin.size);
+ ASSERT(i<=0 || rsa_s_len <= ret_bin.size);
+ EVP_PKEY_CTX_free(ctx);
+ EVP_PKEY_free(pkey);
+#else
enif_alloc_binary(RSA_size(rsa), &ret_bin);
+ len = EVP_MD_size(md);
- ERL_VALGRIND_ASSERT_MEM_DEFINED(digest, digp->len);
- i = RSA_sign(digp->NID_type, digest, digp->len,
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(digest_bin.data, len);
+ i = RSA_sign(md->type, digest_bin.data, len,
ret_bin.data, &rsa_s_len, rsa);
+#endif
RSA_free(rsa);
- if (i) {
+ if (i > 0) {
ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, rsa_s_len);
if (rsa_s_len != ret_bin.size) {
enif_realloc_binary(&ret_bin, rsa_s_len);
@@ -2808,44 +2388,16 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (DigesType|none, Data|{digest,Digest}, Key=[P,Q,G,PrivKey]) */
- ErlNifBinary data_bin, ret_bin;
+{/* (sha, Digest, Key=[P,Q,G,PrivKey]) */
+ ErlNifBinary digest_bin, ret_bin;
ERL_NIF_TERM head, tail;
- unsigned char hmacbuf[SHA_DIGEST_LENGTH];
unsigned int dsa_s_len;
- const ERL_NIF_TERM* tpl_terms;
- int tpl_arity;
- unsigned char* digest = NULL;
DSA* dsa;
int i;
- CHECK_OSE_CRYPTO();
-
- if (argv[0] == atom_sha) {
- if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) {
- if (tpl_arity != 2 || tpl_terms[0] != atom_digest
- || !enif_inspect_binary(env, tpl_terms[1], &data_bin)
- || data_bin.size != SHA_DIGEST_LENGTH) {
-
- return enif_make_badarg(env);
- }
- digest = data_bin.data;
- }
- else {
- if (!enif_inspect_binary(env,argv[1],&data_bin)) {
- return enif_make_badarg(env);
- }
- SHA1(data_bin.data, data_bin.size, hmacbuf);
- digest = hmacbuf;
- }
- }
- else if (argv[0] == atom_none
- && enif_inspect_binary(env,argv[1],&data_bin)
- && data_bin.size == SHA_DIGEST_LENGTH) {
-
- digest = data_bin.data;
- }
- else {
+ if (!argv[0] == atom_sha
+ || !enif_inspect_binary(env, argv[1], &digest_bin)
+ || digest_bin.size != SHA_DIGEST_LENGTH) {
return enif_make_badarg(env);
}
@@ -2866,7 +2418,7 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
}
enif_alloc_binary(DSA_size(dsa), &ret_bin);
- i = DSA_sign(NID_sha1, digest, SHA_DIGEST_LENGTH,
+ i = DSA_sign(NID_sha1, digest_bin.data, SHA_DIGEST_LENGTH,
ret_bin.data, &dsa_s_len, dsa);
DSA_free(dsa);
if (i) {
@@ -2906,8 +2458,6 @@ static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TER
int padding, i;
RSA* rsa;
- CHECK_OSE_CRYPTO();
-
rsa = RSA_new();
if (!enif_inspect_binary(env, argv[0], &data_bin)
@@ -2956,8 +2506,6 @@ static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE
int padding, i;
RSA* rsa;
- CHECK_OSE_CRYPTO();
-
rsa = RSA_new();
if (!enif_inspect_binary(env, argv[0], &data_bin)
@@ -3004,8 +2552,6 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E
unsigned char *p_ptr, *g_ptr;
ERL_NIF_TERM ret_p, ret_g;
- CHECK_OSE_CRYPTO();
-
if (!enif_get_int(env, argv[0], &prime_len)
|| !enif_get_int(env, argv[1], &generator)) {
@@ -3033,8 +2579,6 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
int i;
ERL_NIF_TERM ret, head, tail;
- CHECK_OSE_CRYPTO();
-
dh_params = DH_new();
if (!enif_get_list_cell(env, argv[0], &head, &tail)
@@ -3069,8 +2613,6 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_
ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail;
int mpint; /* 0 or 4 */
- CHECK_OSE_CRYPTO();
-
dh_params = DH_new();
if (!(get_bn_from_bin(env, argv[0], &dh_params->priv_key)
@@ -3115,8 +2657,6 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T
ErlNifBinary ret_bin;
ERL_NIF_TERM ret, head, tail;
- CHECK_OSE_CRYPTO();
-
dh_params = DH_new();
if (!get_bn_from_bin(env, argv[0], &pubkey)
@@ -3139,7 +2679,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T
ret = enif_make_binary(env, &ret_bin);
}
else {
- enif_release_binary(&ret_bin);
+ enif_release_binary(&ret_bin);
ret = atom_error;
}
}
@@ -3157,8 +2697,6 @@ static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
unsigned dlen;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
-
if (!get_bn_from_bin(env, argv[0], &bn_multiplier)
|| !get_bn_from_bin(env, argv[1], &bn_verifier)
|| !get_bn_from_bin(env, argv[2], &bn_generator)
@@ -3219,8 +2757,6 @@ static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_
unsigned dlen;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
-
if (!get_bn_from_bin(env, argv[0], &bn_a)
|| !get_bn_from_bin(env, argv[1], &bn_u)
|| !get_bn_from_bin(env, argv[2], &bn_B)
@@ -3300,8 +2836,6 @@ static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_
unsigned dlen;
ERL_NIF_TERM ret;
- CHECK_OSE_CRYPTO();
-
if (!get_bn_from_bin(env, argv[0], &bn_verifier)
|| !get_bn_from_bin(env, argv[1], &bn_b)
|| !get_bn_from_bin(env, argv[2], &bn_u)
@@ -3354,103 +2888,6 @@ static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_
return ret;
}
-static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Ivec, Data, IsEncrypt) */
- ErlNifBinary key_bin, ivec_bin, data_bin;
- BF_KEY bf_key; /* blowfish key 8 */
- unsigned char bf_tkey[8]; /* blowfish ivec */
- int bf_n = 0; /* blowfish ivec pos */
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || ivec_bin.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) {
- return enif_make_badarg(env);
- }
-
- BF_set_key(&bf_key, key_bin.size, key_bin.data);
- memcpy(bf_tkey, ivec_bin.data, 8);
- BF_cfb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret),
- data_bin.size, &bf_key, bf_tkey, &bf_n,
- (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT));
- CONSUME_REDS(env,data_bin);
- return ret;
-}
-
-static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Ivec, Data, IsEncrypt) */
- ErlNifBinary key_bin, ivec_bin, data_bin;
- BF_KEY bf_key; /* blowfish key 8 */
- unsigned char bf_tkey[8]; /* blowfish ivec */
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || ivec_bin.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)
- || data_bin.size % 8 != 0) {
- return enif_make_badarg(env);
- }
-
- BF_set_key(&bf_key, key_bin.size, key_bin.data);
- memcpy(bf_tkey, ivec_bin.data, 8);
- BF_cbc_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret),
- data_bin.size, &bf_key, bf_tkey,
- (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT));
- CONSUME_REDS(env,data_bin);
- return ret;
-}
-
-static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, Data, IsEncrypt) */
- ErlNifBinary key_bin, data_bin;
- BF_KEY bf_key; /* blowfish key 8 */
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)
- || data_bin.size < 8) {
- return enif_make_badarg(env);
- }
- BF_set_key(&bf_key, key_bin.size, key_bin.data);
- BF_ecb_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret),
- &bf_key, (argv[2] == atom_true ? BF_ENCRYPT : BF_DECRYPT));
- CONSUME_REDS(env,data_bin);
- return ret;
-}
-
-static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Key, IVec, Data) */
- ErlNifBinary key_bin, ivec_bin, data_bin;
- BF_KEY bf_key; /* blowfish key 8 */
- unsigned char bf_tkey[8]; /* blowfish ivec */
- int bf_n = 0; /* blowfish ivec pos */
- ERL_NIF_TERM ret;
-
- CHECK_OSE_CRYPTO();
-
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || ivec_bin.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) {
- return enif_make_badarg(env);
- }
-
- BF_set_key(&bf_key, key_bin.size, key_bin.data);
- memcpy(bf_tkey, ivec_bin.data, 8);
- BF_ofb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret),
- data_bin.size, &bf_key, bf_tkey, &bf_n);
- CONSUME_REDS(env,data_bin);
- return ret;
-}
-
#if defined(HAVE_EC)
static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg)
{
@@ -3762,8 +3199,6 @@ static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM
ERL_NIF_TERM priv_key;
ERL_NIF_TERM pub_key = atom_undefined;
- CHECK_OSE_CRYPTO();
-
if (!get_ec_key(env, argv[0], argv[1], atom_undefined, &key))
goto badarg;
@@ -3793,51 +3228,33 @@ badarg:
}
static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Data|{digest,Digest}, Curve, Key) */
+{/* (Type, Digest, Curve, Key) */
#if defined(HAVE_EC)
- ErlNifBinary data_bin, ret_bin;
- unsigned char hmacbuf[SHA_DIGEST_LENGTH];
+ ErlNifBinary digest_bin, ret_bin;
unsigned int dsa_s_len;
EC_KEY* key = NULL;
- int i;
- const ERL_NIF_TERM* tpl_terms;
- int tpl_arity;
+ int i, len;
struct digest_type_t *digp;
- unsigned char* digest;
-
- CHECK_OSE_CRYPTO();
+ const EVP_MD *md;
digp = get_digest_type(argv[0]);
if (!digp) {
return enif_make_badarg(env);
}
- if (!digp->len) {
+ if (!digp->md_func) {
return atom_notsup;
}
+ md = digp->md_func();
+ len = EVP_MD_size(md);
- if (!get_ec_key(env, argv[2], argv[3], atom_undefined, &key))
+ if (!enif_inspect_binary(env,argv[1],&digest_bin)
+ || digest_bin.size != len
+ || !get_ec_key(env, argv[2], argv[3], atom_undefined, &key))
goto badarg;
- if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) {
- if (tpl_arity != 2 || tpl_terms[0] != atom_digest
- || !enif_inspect_binary(env, tpl_terms[1], &data_bin)
- || data_bin.size != digp->len) {
-
- goto badarg;
- }
- digest = data_bin.data;
- }
- else {
- if (!enif_inspect_binary(env,argv[1],&data_bin)) {
- goto badarg;
- }
- digest = hmacbuf;
- digp->funcp(data_bin.data, data_bin.size, digest);
- }
-
enif_alloc_binary(ECDSA_size(key), &ret_bin);
- i = ECDSA_sign(digp->NID_type, digest, digp->len,
+ i = ECDSA_sign(md->type, digest_bin.data, len,
ret_bin.data, &dsa_s_len, key);
EC_KEY_free(key);
@@ -3862,50 +3279,32 @@ badarg:
}
static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Data|{digest,Digest}, Signature, Curve, Key) */
+{/* (Type, Digest, Signature, Curve, Key) */
#if defined(HAVE_EC)
- ErlNifBinary data_bin, sign_bin;
- unsigned char hmacbuf[SHA512_LEN];
- int i;
+ ErlNifBinary digest_bin, sign_bin;
+ int i, len;
EC_KEY* key = NULL;
const ERL_NIF_TERM type = argv[0];
- const ERL_NIF_TERM* tpl_terms;
- int tpl_arity;
- struct digest_type_t* digp = NULL;
- unsigned char* digest = NULL;
-
- CHECK_OSE_CRYPTO();
+ struct digest_type_t *digp = NULL;
+ const EVP_MD *md;
digp = get_digest_type(type);
if (!digp) {
return enif_make_badarg(env);
}
- if (!digp->len) {
+ if (!digp->md_func) {
return atom_notsup;
}
+ md = digp->md_func();
+ len = EVP_MD_size(md);
- if (!enif_inspect_binary(env, argv[2], &sign_bin)
+ if (!enif_inspect_binary(env, argv[1], &digest_bin)
+ || digest_bin.size != len
+ || !enif_inspect_binary(env, argv[2], &sign_bin)
|| !get_ec_key(env, argv[3], atom_undefined, argv[4], &key))
goto badarg;
- if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) {
- if (tpl_arity != 2 || tpl_terms[0] != atom_digest
- || !enif_inspect_binary(env, tpl_terms[1], &data_bin)
- || data_bin.size != digp->len) {
-
- goto badarg;
- }
- digest = data_bin.data;
- }
- else if (enif_inspect_binary(env, argv[1], &data_bin)) {
- digest = hmacbuf;
- digp->funcp(data_bin.data, data_bin.size, digest);
- }
- else {
- goto badarg;
- }
-
- i = ECDSA_verify(digp->NID_type, digest, digp->len,
+ i = ECDSA_verify(md->type, digest_bin.data, len,
sign_bin.data, sign_bin.size, key);
EC_KEY_free(key);
@@ -3939,8 +3338,6 @@ static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF
EC_POINT *my_ecpoint;
EC_KEY *other_ecdh = NULL;
- CHECK_OSE_CRYPTO();
-
if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key))
return enif_make_badarg(env);
@@ -3984,253 +3381,9 @@ out_err:
static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
ErlNifBinary seed_bin;
- CHECK_OSE_CRYPTO();
+
if (!enif_inspect_binary(env, argv[0], &seed_bin))
return enif_make_badarg(env);
RAND_seed(seed_bin.data,seed_bin.size);
return atom_ok;
}
-
-
-/* HMAC */
-
-static void hmac_md5(unsigned char *key, int klen, unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf)
-{
- MD5_CTX ctx;
- char ipad[HMAC_INT_LEN];
- char opad[HMAC_INT_LEN];
- unsigned char nkey[MD5_LEN];
- int i;
-
- /* Change key if longer than 64 bytes */
- if (klen > HMAC_INT_LEN) {
- MD5(key, klen, nkey);
- key = nkey;
- klen = MD5_LEN;
- }
-
- memset(ipad, '\0', sizeof(ipad));
- memset(opad, '\0', sizeof(opad));
- memcpy(ipad, key, klen);
- memcpy(opad, key, klen);
-
- for (i = 0; i < HMAC_INT_LEN; i++) {
- ipad[i] ^= HMAC_IPAD;
- opad[i] ^= HMAC_OPAD;
- }
-
- /* inner MD5 */
- MD5_Init(&ctx);
- MD5_Update(&ctx, ipad, HMAC_INT_LEN);
- MD5_Update(&ctx, dbuf, dlen);
- MD5_Final((unsigned char *) hmacbuf, &ctx);
- /* outer MD5 */
- MD5_Init(&ctx);
- MD5_Update(&ctx, opad, HMAC_INT_LEN);
- MD5_Update(&ctx, hmacbuf, MD5_LEN);
- MD5_Final((unsigned char *) hmacbuf, &ctx);
-}
-
-static void hmac_sha1(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf)
-{
- SHA_CTX ctx;
- char ipad[HMAC_INT_LEN];
- char opad[HMAC_INT_LEN];
- unsigned char nkey[SHA_LEN];
- int i;
-
- /* Change key if longer than 64 bytes */
- if (klen > HMAC_INT_LEN) {
- SHA1(key, klen, nkey);
- key = nkey;
- klen = SHA_LEN;
- }
-
- memset(ipad, '\0', sizeof(ipad));
- memset(opad, '\0', sizeof(opad));
- memcpy(ipad, key, klen);
- memcpy(opad, key, klen);
-
- for (i = 0; i < HMAC_INT_LEN; i++) {
- ipad[i] ^= HMAC_IPAD;
- opad[i] ^= HMAC_OPAD;
- }
-
- /* inner SHA */
- SHA1_Init(&ctx);
- SHA1_Update(&ctx, ipad, HMAC_INT_LEN);
- SHA1_Update(&ctx, dbuf, dlen);
- SHA1_Final((unsigned char *) hmacbuf, &ctx);
- /* outer SHA */
- SHA1_Init(&ctx);
- SHA1_Update(&ctx, opad, HMAC_INT_LEN);
- SHA1_Update(&ctx, hmacbuf, SHA_LEN);
- SHA1_Final((unsigned char *) hmacbuf, &ctx);
-}
-
-#ifdef HAVE_SHA224
-static void hmac_sha224(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf)
-{
- SHA256_CTX ctx;
- char ipad[HMAC_INT_LEN];
- char opad[HMAC_INT_LEN];
- unsigned char nkey[SHA224_DIGEST_LENGTH];
- int i;
-
- /* Change key if longer than 64 bytes */
- if (klen > HMAC_INT_LEN) {
- SHA224(key, klen, nkey);
- key = nkey;
- klen = SHA224_DIGEST_LENGTH;
- }
-
- memset(ipad, '\0', sizeof(ipad));
- memset(opad, '\0', sizeof(opad));
- memcpy(ipad, key, klen);
- memcpy(opad, key, klen);
-
- for (i = 0; i < HMAC_INT_LEN; i++) {
- ipad[i] ^= HMAC_IPAD;
- opad[i] ^= HMAC_OPAD;
- }
-
- /* inner SHA */
- SHA224_Init(&ctx);
- SHA224_Update(&ctx, ipad, HMAC_INT_LEN);
- SHA224_Update(&ctx, dbuf, dlen);
- SHA224_Final((unsigned char *) hmacbuf, &ctx);
- /* outer SHA */
- SHA224_Init(&ctx);
- SHA224_Update(&ctx, opad, HMAC_INT_LEN);
- SHA224_Update(&ctx, hmacbuf, SHA224_DIGEST_LENGTH);
- SHA224_Final((unsigned char *) hmacbuf, &ctx);
-}
-#endif
-
-#ifdef HAVE_SHA256
-static void hmac_sha256(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf)
-{
- SHA256_CTX ctx;
- char ipad[HMAC_INT_LEN];
- char opad[HMAC_INT_LEN];
- unsigned char nkey[SHA256_DIGEST_LENGTH];
- int i;
-
- /* Change key if longer than 64 bytes */
- if (klen > HMAC_INT_LEN) {
- SHA256(key, klen, nkey);
- key = nkey;
- klen = SHA256_DIGEST_LENGTH;
- }
-
- memset(ipad, '\0', sizeof(ipad));
- memset(opad, '\0', sizeof(opad));
- memcpy(ipad, key, klen);
- memcpy(opad, key, klen);
-
- for (i = 0; i < HMAC_INT_LEN; i++) {
- ipad[i] ^= HMAC_IPAD;
- opad[i] ^= HMAC_OPAD;
- }
-
- /* inner SHA */
- SHA256_Init(&ctx);
- SHA256_Update(&ctx, ipad, HMAC_INT_LEN);
- SHA256_Update(&ctx, dbuf, dlen);
- SHA256_Final((unsigned char *) hmacbuf, &ctx);
- /* outer SHA */
- SHA256_Init(&ctx);
- SHA256_Update(&ctx, opad, HMAC_INT_LEN);
- SHA256_Update(&ctx, hmacbuf, SHA256_DIGEST_LENGTH);
- SHA256_Final((unsigned char *) hmacbuf, &ctx);
-}
-#endif
-
-#ifdef HAVE_SHA384
-static void hmac_sha384(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf)
-{
- SHA512_CTX ctx;
- char ipad[HMAC_INT2_LEN];
- char opad[HMAC_INT2_LEN];
- unsigned char nkey[SHA384_DIGEST_LENGTH];
- int i;
-
- /* Change key if longer than 64 bytes */
- if (klen > HMAC_INT2_LEN) {
- SHA384(key, klen, nkey);
- key = nkey;
- klen = SHA384_DIGEST_LENGTH;
- }
-
- memset(ipad, '\0', sizeof(ipad));
- memset(opad, '\0', sizeof(opad));
- memcpy(ipad, key, klen);
- memcpy(opad, key, klen);
-
- for (i = 0; i < HMAC_INT2_LEN; i++) {
- ipad[i] ^= HMAC_IPAD;
- opad[i] ^= HMAC_OPAD;
- }
-
- /* inner SHA */
- SHA384_Init(&ctx);
- SHA384_Update(&ctx, ipad, HMAC_INT2_LEN);
- SHA384_Update(&ctx, dbuf, dlen);
- SHA384_Final((unsigned char *) hmacbuf, &ctx);
- /* outer SHA */
- SHA384_Init(&ctx);
- SHA384_Update(&ctx, opad, HMAC_INT2_LEN);
- SHA384_Update(&ctx, hmacbuf, SHA384_DIGEST_LENGTH);
- SHA384_Final((unsigned char *) hmacbuf, &ctx);
-}
-#endif
-
-#ifdef HAVE_SHA512
-static void hmac_sha512(unsigned char *key, int klen,
- unsigned char *dbuf, int dlen,
- unsigned char *hmacbuf)
-{
- SHA512_CTX ctx;
- char ipad[HMAC_INT2_LEN];
- char opad[HMAC_INT2_LEN];
- unsigned char nkey[SHA512_DIGEST_LENGTH];
- int i;
-
- /* Change key if longer than 64 bytes */
- if (klen > HMAC_INT2_LEN) {
- SHA512(key, klen, nkey);
- key = nkey;
- klen = SHA512_DIGEST_LENGTH;
- }
-
- memset(ipad, '\0', sizeof(ipad));
- memset(opad, '\0', sizeof(opad));
- memcpy(ipad, key, klen);
- memcpy(opad, key, klen);
-
- for (i = 0; i < HMAC_INT2_LEN; i++) {
- ipad[i] ^= HMAC_IPAD;
- opad[i] ^= HMAC_OPAD;
- }
-
- /* inner SHA */
- SHA512_Init(&ctx);
- SHA512_Update(&ctx, ipad, HMAC_INT2_LEN);
- SHA512_Update(&ctx, dbuf, dlen);
- SHA512_Final((unsigned char *) hmacbuf, &ctx);
- /* outer SHA */
- SHA512_Init(&ctx);
- SHA512_Update(&ctx, opad, HMAC_INT2_LEN);
- SHA512_Update(&ctx, hmacbuf, SHA512_DIGEST_LENGTH);
- SHA512_Final((unsigned char *) hmacbuf, &ctx);
-}
-#endif
diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c
index e0de16074c..af9545bd63 100644
--- a/lib/crypto/c_src/crypto_callback.c
+++ b/lib/crypto/c_src/crypto_callback.c
@@ -43,6 +43,10 @@
#ifdef __WIN32__
# define DLLEXPORT __declspec(dllexport)
+#elif defined(__GNUC__) && __GNUC__ >= 4
+# define DLLEXPORT __attribute__ ((visibility("default")))
+#elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550)
+# define DLLEXPORT __global
#else
# define DLLEXPORT
#endif
@@ -51,8 +55,6 @@
DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks);
-static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */
-
static void nomem(size_t size, const char* op)
{
fprintf(stderr, "Out of memory abort. Crypto failed to %s %zu bytes.\r\n",
@@ -84,6 +86,8 @@ static void crypto_free(void* ptr)
#ifdef OPENSSL_THREADS /* vvvvvvvvvvvvvvv OPENSSL_THREADS vvvvvvvvvvvvvvvv */
+static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */
+
#include <openssl/crypto.h>
static INLINE void locking(int mode, ErlNifRWLock* lock)
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 563a090e98..d3e827b3e6 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -135,9 +135,8 @@
<code>stream_cipher() = rc4 | aes_ctr </code>
- <code>block_cipher() = aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc |
- blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf
- | des_ede3 | rc2_cbc </code>
+ <code>block_cipher() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc |
+ blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | rc2_cbc </code>
<code>aead_cipher() = aes_gcm | chacha20_poly1305 </code>
@@ -160,8 +159,9 @@
<code> hash_algorithms() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512 </code> <p>md4 is also supported for hash_init/1 and hash/2.
Note that both md4 and md5 are recommended only for compatibility with existing applications.
</p>
- <code> cipher_algorithms() = des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 |
- blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | aes_gcm | chacha20_poly1305 | rc2_cbc | aes_ctr| rc4 </code>
+ <code> cipher_algorithms() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ctr | aes_gcm |
+ aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc | des_cfb |
+ des3_cbc | des3_cbf | des_ede3 | rc2_cbc | rc4 </code>
<code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code>
<p>Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported
with ecdsa and ecdh.
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index 38e71591f3..3e24ff2b0a 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -210,10 +210,8 @@ supports()->
{Hashs, PubKeys, Ciphers} = algorithms(),
[{hashs, Hashs},
- {ciphers, [des_cbc, des_cfb, des3_cbc, des_ede3, blowfish_cbc,
- blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb8, aes_cfb128,
- aes_cbc256, rc2_cbc, aes_ctr, rc4, aes_ecb] ++ Ciphers},
- {public_keys, [rsa, dss, dh, srp] ++ PubKeys}
+ {ciphers, Ciphers},
+ {public_keys, PubKeys}
].
info_lib() -> ?nif_stub.
@@ -222,20 +220,14 @@ info_lib() -> ?nif_stub.
hash(Hash, Data0) ->
Data = iolist_to_binary(Data0),
- MaxByts = max_bytes(),
- hash(Hash, Data, erlang:byte_size(Data), MaxByts, initial).
+ MaxBytes = max_bytes(),
+ hash(Hash, Data, erlang:byte_size(Data), MaxBytes).
-spec hash_init('md5'|'md4'|'ripemd160'|
'sha'|'sha224'|'sha256'|'sha384'|'sha512') -> any().
-hash_init(md5) -> {md5, md5_init()};
-hash_init(md4) -> {md4, md4_init()};
-hash_init(sha) -> {sha, sha_init()};
-hash_init(ripemd160) -> {ripemd160, ripemd160_init()};
-hash_init(sha224) -> {sha224, sha224_init()};
-hash_init(sha256) -> {sha256, sha256_init()};
-hash_init(sha384) -> {sha384, sha384_init()};
-hash_init(sha512) -> {sha512, sha512_init()}.
+hash_init(Hash) ->
+ notsup_to_error(hash_init_nif(Hash)).
-spec hash_update(_, iodata()) -> any().
@@ -246,14 +238,8 @@ hash_update(State, Data0) ->
-spec hash_final(_) -> binary().
-hash_final({md5,Context}) -> md5_final(Context);
-hash_final({md4,Context}) -> md4_final(Context);
-hash_final({sha,Context}) -> sha_final(Context);
-hash_final({ripemd160,Context}) -> ripemd160_final(Context);
-hash_final({sha224,Context}) -> sha224_final(Context);
-hash_final({sha256,Context}) -> sha256_final(Context);
-hash_final({sha384,Context}) -> sha384_final(Context);
-hash_final({sha512,Context}) -> sha512_final(Context).
+hash_final(State) ->
+ notsup_to_error(hash_final_nif(State)).
-spec hmac(_, iodata(), iodata()) -> binary().
@@ -265,151 +251,132 @@ hash_final({sha512,Context}) -> sha512_final(Context).
hmac(Type, Key, Data0) ->
Data = iolist_to_binary(Data0),
- hmac(Type, Key, Data, undefined, erlang:byte_size(Data), max_bytes(), initial).
+ hmac(Type, Key, Data, undefined, erlang:byte_size(Data), max_bytes()).
hmac(Type, Key, Data0, MacSize) ->
Data = iolist_to_binary(Data0),
- hmac(Type, Key, Data, MacSize, erlang:byte_size(Data), max_bytes(), initial).
-
+ hmac(Type, Key, Data, MacSize, erlang:byte_size(Data), max_bytes()).
-hmac_init(_Type, _Key) -> ?nif_stub.
+hmac_init(Type, Key) ->
+ notsup_to_error(hmac_init_nif(Type, Key)).
hmac_update(State, Data0) ->
Data = iolist_to_binary(Data0),
hmac_update(State, Data, erlang:byte_size(Data), max_bytes()).
-hmac_final(_Context) -> ? nif_stub.
-hmac_final_n(_Context, _HashLen) -> ? nif_stub.
+
+hmac_final(Context) ->
+ notsup_to_error(hmac_final_nif(Context)).
+hmac_final_n(Context, HashLen) ->
+ notsup_to_error(hmac_final_nif(Context, HashLen)).
%% Ecrypt/decrypt %%%
--spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc |
- blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | rc2_cbc,
+-spec block_encrypt(des_cbc | des_cfb |
+ des3_cbc | des3_cbf | des_ede3 |
+ blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 |
+ aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 |
+ aes_cbc |
+ rc2_cbc,
Key::iodata(), Ivec::binary(), Data::iodata()) -> binary();
(aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}.
-block_encrypt(des_cbc, Key, Ivec, Data) ->
- des_cbc_encrypt(Key, Ivec, Data);
-block_encrypt(des_cfb, Key, Ivec, Data) ->
- des_cfb_encrypt(Key, Ivec, Data);
-block_encrypt(des3_cbc, [Key1, Key2, Key3], Ivec, Data) ->
- des3_cbc_encrypt(Key1, Key2, Key3, Ivec, Data);
-block_encrypt(des3_cbf, [Key1, Key2, Key3], Ivec, Data) ->
- des3_cfb_encrypt(Key1, Key2, Key3, Ivec, Data);
-block_encrypt(des_ede3, [Key1, Key2, Key3], Ivec, Data) ->
- des_ede3_cbc_encrypt(Key1, Key2, Key3, Ivec, Data);
-block_encrypt(blowfish_cbc, Key, Ivec, Data) ->
- blowfish_cbc_encrypt(Key, Ivec, Data);
-block_encrypt(blowfish_cfb64, Key, Ivec, Data) ->
- blowfish_cfb64_encrypt(Key, Ivec, Data);
-block_encrypt(blowfish_ofb64, Key, Ivec, Data) ->
- blowfish_ofb64_encrypt(Key, Ivec, Data);
-block_encrypt(aes_cbc128, Key, Ivec, Data) ->
- aes_cbc_128_encrypt(Key, Ivec, Data);
-block_encrypt(aes_cbc256, Key, Ivec, Data) ->
- aes_cbc_256_encrypt(Key, Ivec, Data);
+block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc;
+ Type =:= des_cfb;
+ Type =:= blowfish_cbc;
+ Type =:= blowfish_cfb64;
+ Type =:= blowfish_ofb64;
+ Type =:= aes_cbc128;
+ Type =:= aes_cfb8;
+ Type =:= aes_cfb128;
+ Type =:= aes_cbc256;
+ Type =:= aes_cbc;
+ Type =:= rc2_cbc ->
+ block_crypt_nif(Type, Key, Ivec, Data, true);
+block_encrypt(Type, Key0, Ivec, Data) when Type =:= des3_cbc;
+ Type =:= des_ede3 ->
+ Key = check_des3_key(Key0),
+ block_crypt_nif(des_ede3_cbc, Key, Ivec, Data, true);
+block_encrypt(des3_cbf, Key0, Ivec, Data) ->
+ Key = check_des3_key(Key0),
+ block_crypt_nif(des_ede3_cbf, Key, Ivec, Data, true);
block_encrypt(aes_ige256, Key, Ivec, Data) ->
- aes_ige_256_encrypt(Key, Ivec, Data);
-block_encrypt(aes_cfb8, Key, Ivec, Data) ->
- aes_cfb_8_encrypt(Key, Ivec, Data);
-block_encrypt(aes_cfb128, Key, Ivec, Data) ->
- aes_cfb_128_encrypt(Key, Ivec, Data);
+ aes_ige_crypt_nif(Key, Ivec, Data, true);
block_encrypt(aes_gcm, Key, Ivec, {AAD, Data}) ->
- case aes_gcm_encrypt(Key, Ivec, AAD, Data) of
- notsup -> erlang:error(notsup);
- Return -> Return
- end;
+ aes_gcm_encrypt(Key, Ivec, AAD, Data);
block_encrypt(chacha20_poly1305, Key, Ivec, {AAD, Data}) ->
- case chacha20_poly1305_encrypt(Key, Ivec, AAD, Data) of
- notsup -> erlang:error(notsup);
- Return -> Return
- end;
-block_encrypt(rc2_cbc, Key, Ivec, Data) ->
- rc2_cbc_encrypt(Key, Ivec, Data).
-
--spec block_decrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc |
- blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 |
- aes_cfb8 | aes_cfb128 | rc2_cbc,
+ chacha20_poly1305_encrypt(Key, Ivec, AAD, Data).
+
+-spec block_decrypt(des_cbc | des_cfb |
+ des3_cbc | des3_cbf | des_ede3 |
+ blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 |
+ aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 |
+ aes_cbc |
+ rc2_cbc,
Key::iodata(), Ivec::binary(), Data::iodata()) -> binary();
(aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(),
{AAD::binary(), Data::iodata(), Tag::binary()}) -> binary() | error.
-block_decrypt(des_cbc, Key, Ivec, Data) ->
- des_cbc_decrypt(Key, Ivec, Data);
-block_decrypt(des_cfb, Key, Ivec, Data) ->
- des_cfb_decrypt(Key, Ivec, Data);
-block_decrypt(des3_cbc, [Key1, Key2, Key3], Ivec, Data) ->
- des3_cbc_decrypt(Key1, Key2, Key3, Ivec, Data);
-block_decrypt(des3_cbf, [Key1, Key2, Key3], Ivec, Data) ->
- des3_cfb_decrypt(Key1, Key2, Key3, Ivec, Data);
-block_decrypt(des_ede3, [Key1, Key2, Key3], Ivec, Data) ->
- des_ede3_cbc_decrypt(Key1, Key2, Key3, Ivec, Data);
-block_decrypt(blowfish_cbc, Key, Ivec, Data) ->
- blowfish_cbc_decrypt(Key, Ivec, Data);
-block_decrypt(blowfish_cfb64, Key, Ivec, Data) ->
- blowfish_cfb64_decrypt(Key, Ivec, Data);
-block_decrypt(blowfish_ofb64, Key, Ivec, Data) ->
- blowfish_ofb64_decrypt(Key, Ivec, Data);
-block_decrypt(aes_cbc128, Key, Ivec, Data) ->
- aes_cbc_128_decrypt(Key, Ivec, Data);
-block_decrypt(aes_cbc256, Key, Ivec, Data) ->
- aes_cbc_256_decrypt(Key, Ivec, Data);
+block_decrypt(Type, Key, Ivec, Data) when Type =:= des_cbc;
+ Type =:= des_cfb;
+ Type =:= blowfish_cbc;
+ Type =:= blowfish_cfb64;
+ Type =:= blowfish_ofb64;
+ Type =:= aes_cbc;
+ Type =:= aes_cbc128;
+ Type =:= aes_cfb8;
+ Type =:= aes_cfb128;
+ Type =:= aes_cbc256;
+ Type =:= rc2_cbc ->
+ block_crypt_nif(Type, Key, Ivec, Data, false);
+block_decrypt(Type, Key0, Ivec, Data) when Type =:= des3_cbc;
+ Type =:= des_ede3 ->
+ Key = check_des3_key(Key0),
+ block_crypt_nif(des_ede3_cbc, Key, Ivec, Data, false);
+block_decrypt(des3_cbf, Key0, Ivec, Data) ->
+ Key = check_des3_key(Key0),
+ block_crypt_nif(des_ede3_cbf, Key, Ivec, Data, false);
block_decrypt(aes_ige256, Key, Ivec, Data) ->
- aes_ige_256_decrypt(Key, Ivec, Data);
-block_decrypt(aes_cfb8, Key, Ivec, Data) ->
- aes_cfb_8_decrypt(Key, Ivec, Data);
-block_decrypt(aes_cfb128, Key, Ivec, Data) ->
- aes_cfb_128_decrypt(Key, Ivec, Data);
+ notsup_to_error(aes_ige_crypt_nif(Key, Ivec, Data, false));
block_decrypt(aes_gcm, Key, Ivec, {AAD, Data, Tag}) ->
- case aes_gcm_decrypt(Key, Ivec, AAD, Data, Tag) of
- notsup -> erlang:error(notsup);
- Return -> Return
- end;
+ aes_gcm_decrypt(Key, Ivec, AAD, Data, Tag);
block_decrypt(chacha20_poly1305, Key, Ivec, {AAD, Data, Tag}) ->
- case chacha20_poly1305_decrypt(Key, Ivec, AAD, Data, Tag) of
- notsup -> erlang:error(notsup);
- Return -> Return
- end;
-block_decrypt(rc2_cbc, Key, Ivec, Data) ->
- rc2_cbc_decrypt(Key, Ivec, Data).
+ chacha20_poly1305_decrypt(Key, Ivec, AAD, Data, Tag).
-spec block_encrypt(des_ecb | blowfish_ecb | aes_ecb, Key::iodata(), Data::iodata()) -> binary().
-block_encrypt(des_ecb, Key, Data) ->
- des_ecb_encrypt(Key, Data);
-block_encrypt(blowfish_ecb, Key, Data) ->
- blowfish_ecb_encrypt(Key, Data);
-block_encrypt(aes_ecb, Key, Data) ->
- aes_ecb_encrypt(Key, Data).
+block_encrypt(Type, Key, Data) ->
+ block_crypt_nif(Type, Key, Data, true).
-spec block_decrypt(des_ecb | blowfish_ecb | aes_ecb, Key::iodata(), Data::iodata()) -> binary().
-block_decrypt(des_ecb, Key, Data) ->
- des_ecb_decrypt(Key, Data);
-block_decrypt(blowfish_ecb, Key, Data) ->
- blowfish_ecb_decrypt(Key, Data);
-block_decrypt(aes_ecb, Key, Data) ->
- aes_ecb_decrypt(Key, Data).
+block_decrypt(Type, Key, Data) ->
+ block_crypt_nif(Type, Key, Data, false).
-spec next_iv(des_cbc | des3_cbc | aes_cbc | aes_ige, Data::iodata()) -> binary().
-next_iv(des_cbc, Data) ->
- des_cbc_ivec(Data);
-next_iv(des3_cbc, Data) ->
- des_cbc_ivec(Data);
-next_iv(aes_cbc, Data) ->
- aes_cbc_ivec(Data);
-next_iv(aes_ige, Data) ->
- aes_ige_ivec(Data).
+next_iv(Type, Data) when is_binary(Data) ->
+ IVecSize = case Type of
+ des_cbc -> 8;
+ des3_cbc -> 8;
+ aes_cbc -> 16;
+ aes_ige -> 32
+ end,
+ {_, IVec} = split_binary(Data, size(Data) - IVecSize),
+ IVec;
+next_iv(Type, Data) when is_list(Data) ->
+ next_iv(Type, list_to_binary(Data)).
-spec next_iv(des_cfb, Data::iodata(), Ivec::binary()) -> binary().
-next_iv(des_cfb, Data, Ivec) ->
- des_cfb_ivec(Ivec, Data);
+next_iv(des_cfb, Data, IVec) ->
+ IVecAndData = list_to_binary([IVec, Data]),
+ {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8),
+ NewIVec;
next_iv(Type, Data, _Ivec) ->
next_iv(Type, Data).
stream_init(aes_ctr, Key, Ivec) ->
{aes_ctr, aes_ctr_stream_init(Key, Ivec)}.
stream_init(rc4, Key) ->
- {rc4, rc4_set_key(Key)}.
+ {rc4, notsup_to_error(rc4_set_key(Key))}.
stream_encrypt(State, Data0) ->
Data = iolist_to_binary(Data0),
@@ -485,35 +452,31 @@ verify(dss, none, Data, Signature, Key) when is_binary(Data) ->
verify(dss, sha, {digest, Data}, Signature, Key);
verify(Alg, Type, Data, Signature, Key) when is_binary(Data) ->
verify(Alg, Type, {digest, hash(Type, Data)}, Signature, Key);
-verify(dss, Type, Data, Signature, Key) ->
- dss_verify_nif(Type, Data, Signature, map_ensure_int_as_bin(Key));
-verify(rsa, Type, DataOrDigest, Signature, Key) ->
- case rsa_verify_nif(Type, DataOrDigest, Signature, map_ensure_int_as_bin(Key)) of
- notsup -> erlang:error(notsup);
- Bool -> Bool
- end;
-verify(ecdsa, Type, DataOrDigest, Signature, [Key, Curve]) ->
- case ecdsa_verify_nif(Type, DataOrDigest, Signature, nif_curve_params(Curve), ensure_int_as_bin(Key)) of
- notsup -> erlang:error(notsup);
- Bool -> Bool
- end.
+verify(dss, Type, {digest, Digest}, Signature, Key) ->
+ dss_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key));
+verify(rsa, Type, {digest, Digest}, Signature, Key) ->
+ notsup_to_error(
+ rsa_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key)));
+verify(ecdsa, Type, {digest, Digest}, Signature, [Key, Curve]) ->
+ notsup_to_error(
+ ecdsa_verify_nif(Type, Digest, Signature, nif_curve_params(Curve), ensure_int_as_bin(Key))).
sign(dss, none, Data, Key) when is_binary(Data) ->
sign(dss, sha, {digest, Data}, Key);
sign(Alg, Type, Data, Key) when is_binary(Data) ->
sign(Alg, Type, {digest, hash(Type, Data)}, Key);
-sign(rsa, Type, DataOrDigest, Key) ->
- case rsa_sign_nif(Type, DataOrDigest, map_ensure_int_as_bin(Key)) of
- error -> erlang:error(badkey, [Type,DataOrDigest,Key]);
+sign(rsa, Type, {digest, Digest}, Key) ->
+ case rsa_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of
+ error -> erlang:error(badkey, [Type,Digest,Key]);
Sign -> Sign
end;
-sign(dss, Type, DataOrDigest, Key) ->
- case dss_sign_nif(Type, DataOrDigest, map_ensure_int_as_bin(Key)) of
- error -> erlang:error(badkey, [DataOrDigest, Key]);
+sign(dss, Type, {digest, Digest}, Key) ->
+ case dss_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of
+ error -> erlang:error(badkey, [Digest, Key]);
Sign -> Sign
end;
-sign(ecdsa, Type, DataOrDigest, [Key, Curve]) ->
- case ecdsa_sign_nif(Type, DataOrDigest, nif_curve_params(Curve), ensure_int_as_bin(Key)) of
- error -> erlang:error(badkey, [Type,DataOrDigest,Key]);
+sign(ecdsa, Type, {digest, Digest}, [Key, Curve]) ->
+ case ecdsa_sign_nif(Type, Digest, nif_curve_params(Curve), ensure_int_as_bin(Key)) of
+ error -> erlang:error(badkey, [Type,Digest,Key]);
Sign -> Sign
end.
@@ -618,8 +581,9 @@ compute_key(srp, HostPublic, {UserPublic, UserPrivate},
HostPubBin, Prime);
[S] -> S
end,
+ notsup_to_error(
srp_user_secret_nif(ensure_int_as_bin(UserPrivate), Scrambler, HostPubBin,
- Multiplier, Generator, DerivedKey, Prime);
+ Multiplier, Generator, DerivedKey, Prime));
compute_key(srp, UserPublic, {HostPublic, HostPrivate},
{host,[Verifier, Prime, Version | ScramblerArg]}) when
@@ -631,8 +595,9 @@ compute_key(srp, UserPublic, {HostPublic, HostPrivate},
[] -> srp_scrambler(Version, UserPubBin, ensure_int_as_bin(HostPublic), Prime);
[S] -> S
end,
+ notsup_to_error(
srp_host_secret_nif(Verifier, ensure_int_as_bin(HostPrivate), Scrambler,
- UserPubBin, Prime);
+ UserPubBin, Prime));
compute_key(ecdh, Others, My, Curve) ->
ecdh_compute_key_nif(ensure_int_as_bin(Others),
@@ -677,7 +642,8 @@ on_load() ->
end
end,
Lib = filename:join([PrivDir, "lib", LibName]),
- Status = case erlang:load_nif(Lib, {?CRYPTO_NIF_VSN,path2bin(Lib)}) of
+ LibBin = path2bin(Lib),
+ Status = case erlang:load_nif(Lib, {?CRYPTO_NIF_VSN,LibBin}) of
ok -> ok;
{error, {load_failed, _}}=Error1 ->
ArchLibDir =
@@ -689,7 +655,8 @@ on_load() ->
[] -> Error1;
_ ->
ArchLib = filename:join([ArchLibDir, LibName]),
- erlang:load_nif(ArchLib, {?CRYPTO_NIF_VSN,path2bin(ArchLib)})
+ ArchBin = path2bin(ArchLib),
+ erlang:load_nif(ArchLib, {?CRYPTO_NIF_VSN,ArchBin})
end;
Error1 -> Error1
end,
@@ -714,46 +681,30 @@ path2bin(Path) when is_list(Path) ->
max_bytes() ->
?MAX_BYTES_TO_NIF.
+notsup_to_error(notsup) ->
+ erlang:error(notsup);
+notsup_to_error(Other) ->
+ Other.
+
%% HASH --------------------------------------------------------------------
-hash(Hash, Data, Size, Max, initial) when Size =< Max ->
- do_hash(Hash, Data);
-hash(State0, Data, Size, Max, continue) when Size =< Max ->
- State = do_hash_update(State0, Data),
- hash_final(State);
-hash(Hash, Data, _Size, Max, initial) ->
- <<Increment:Max/binary, Rest/binary>> = Data,
+hash(Hash, Data, Size, Max) when Size =< Max ->
+ notsup_to_error(hash_nif(Hash, Data));
+hash(Hash, Data, Size, Max) ->
State0 = hash_init(Hash),
- State = do_hash_update(State0, Increment),
- hash(State, Rest, erlang:byte_size(Rest), max_bytes(), continue);
-hash(State0, Data, _Size, MaxByts, continue) ->
- <<Increment:MaxByts/binary, Rest/binary>> = Data,
- State = do_hash_update(State0, Increment),
- hash(State, Rest, erlang:byte_size(Rest), max_bytes(), continue).
-
-do_hash(md5, Data) -> md5(Data);
-do_hash(md4, Data) -> md4(Data);
-do_hash(sha, Data) -> sha(Data);
-do_hash(ripemd160, Data) -> ripemd160(Data);
-do_hash(sha224, Data) -> sha224(Data);
-do_hash(sha256, Data) -> sha256(Data);
-do_hash(sha384, Data) -> sha384(Data);
-do_hash(sha512, Data) -> sha512(Data).
+ State1 = hash_update(State0, Data, Size, Max),
+ hash_final(State1).
hash_update(State, Data, Size, MaxBytes) when Size =< MaxBytes ->
- do_hash_update(State, Data);
+ notsup_to_error(hash_update_nif(State, Data));
hash_update(State0, Data, _, MaxBytes) ->
<<Increment:MaxBytes/binary, Rest/binary>> = Data,
- State = do_hash_update(State0, Increment),
+ State = notsup_to_error(hash_update_nif(State0, Increment)),
hash_update(State, Rest, erlang:byte_size(Rest), MaxBytes).
-do_hash_update({md5,Context}, Data) -> {md5, md5_update(Context,Data)};
-do_hash_update({md4,Context}, Data) -> {md4, md4_update(Context,Data)};
-do_hash_update({sha,Context}, Data) -> {sha, sha_update(Context,Data)};
-do_hash_update({ripemd160,Context}, Data) -> {ripemd160, ripemd160_update(Context,Data)};
-do_hash_update({sha224,Context}, Data) -> {sha224, sha224_update(Context,Data)};
-do_hash_update({sha256,Context}, Data) -> {sha256, sha256_update(Context,Data)};
-do_hash_update({sha384,Context}, Data) -> {sha384, sha384_update(Context,Data)};
-do_hash_update({sha512,Context}, Data) -> {sha512, sha512_update(Context,Data)}.
+hash_nif(_Hash, _Data) -> ?nif_stub.
+hash_init_nif(_Hash) -> ?nif_stub.
+hash_update_nif(_State, _Data) -> ?nif_stub.
+hash_final_nif(_State) -> ?nif_stub.
%%
@@ -765,10 +716,14 @@ do_hash_update({sha512,Context}, Data) -> {sha512, sha512_update(Context,Data
-spec md5_update(binary(), iodata()) -> binary().
-spec md5_final(binary()) -> binary().
-md5(_Data) -> ?nif_stub.
-md5_init() -> ?nif_stub.
-md5_update(_Context, _Data) -> ?nif_stub.
-md5_final(_Context) -> ?nif_stub.
+md5(Data) ->
+ hash(md5, Data).
+md5_init() ->
+ hash_init(md5).
+md5_update(Context, Data) ->
+ hash_update(Context, Data).
+md5_final(Context) ->
+ hash_final(Context).
%%
%% MD4
@@ -778,24 +733,14 @@ md5_final(_Context) -> ?nif_stub.
-spec md4_update(binary(), iodata()) -> binary().
-spec md4_final(binary()) -> binary().
-md4(_Data) -> ?nif_stub.
-md4_init() -> ?nif_stub.
-md4_update(_Context, _Data) -> ?nif_stub.
-md4_final(_Context) -> ?nif_stub.
-
-%%
-%% RIPEMD160
-%%
-
--spec ripemd160(iodata()) -> binary().
--spec ripemd160_init() -> binary().
--spec ripemd160_update(binary(), iodata()) -> binary().
--spec ripemd160_final(binary()) -> binary().
-
-ripemd160(_Data) -> ?nif_stub.
-ripemd160_init() -> ?nif_stub.
-ripemd160_update(_Context, _Data) -> ?nif_stub.
-ripemd160_final(_Context) -> ?nif_stub.
+md4(Data) ->
+ hash(md4, Data).
+md4_init() ->
+ hash_init(md4).
+md4_update(Context, Data) ->
+ hash_update(Context, Data).
+md4_final(Context) ->
+ hash_final(Context).
%%
%% SHA
@@ -805,196 +750,44 @@ ripemd160_final(_Context) -> ?nif_stub.
-spec sha_update(binary(), iodata()) -> binary().
-spec sha_final(binary()) -> binary().
-sha(_Data) -> ?nif_stub.
-sha_init() -> ?nif_stub.
-sha_update(_Context, _Data) -> ?nif_stub.
-sha_final(_Context) -> ?nif_stub.
-
-%
-%% SHA224
-%%
--spec sha224(iodata()) -> binary().
--spec sha224_init() -> binary().
--spec sha224_update(binary(), iodata()) -> binary().
--spec sha224_final(binary()) -> binary().
-
-sha224(Data) ->
- case sha224_nif(Data) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha224_init() ->
- case sha224_init_nif() of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha224_update(Context, Data) ->
- case sha224_update_nif(Context, Data) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha224_final(Context) ->
- case sha224_final_nif(Context) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-
-sha224_nif(_Data) -> ?nif_stub.
-sha224_init_nif() -> ?nif_stub.
-sha224_update_nif(_Context, _Data) -> ?nif_stub.
-sha224_final_nif(_Context) -> ?nif_stub.
-
-%
-%% SHA256
-%%
--spec sha256(iodata()) -> binary().
--spec sha256_init() -> binary().
--spec sha256_update(binary(), iodata()) -> binary().
--spec sha256_final(binary()) -> binary().
-
-sha256(Data) ->
- case sha256_nif(Data) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha256_init() ->
- case sha256_init_nif() of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha256_update(Context, Data) ->
- case sha256_update_nif(Context, Data) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha256_final(Context) ->
- case sha256_final_nif(Context) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-
-sha256_nif(_Data) -> ?nif_stub.
-sha256_init_nif() -> ?nif_stub.
-sha256_update_nif(_Context, _Data) -> ?nif_stub.
-sha256_final_nif(_Context) -> ?nif_stub.
-
-%
-%% SHA384
-%%
--spec sha384(iodata()) -> binary().
--spec sha384_init() -> binary().
--spec sha384_update(binary(), iodata()) -> binary().
--spec sha384_final(binary()) -> binary().
-
-sha384(Data) ->
- case sha384_nif(Data) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha384_init() ->
- case sha384_init_nif() of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha384_update(Context, Data) ->
- case sha384_update_nif(Context, Data) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha384_final(Context) ->
- case sha384_final_nif(Context) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-
-sha384_nif(_Data) -> ?nif_stub.
-sha384_init_nif() -> ?nif_stub.
-sha384_update_nif(_Context, _Data) -> ?nif_stub.
-sha384_final_nif(_Context) -> ?nif_stub.
-
-%
-%% SHA512
-%%
--spec sha512(iodata()) -> binary().
--spec sha512_init() -> binary().
--spec sha512_update(binary(), iodata()) -> binary().
--spec sha512_final(binary()) -> binary().
-
-sha512(Data) ->
- case sha512_nif(Data) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha512_init() ->
- case sha512_init_nif() of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha512_update(Context, Data) ->
- case sha512_update_nif(Context, Data) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-sha512_final(Context) ->
- case sha512_final_nif(Context) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-
-sha512_nif(_Data) -> ?nif_stub.
-sha512_init_nif() -> ?nif_stub.
-sha512_update_nif(_Context, _Data) -> ?nif_stub.
-sha512_final_nif(_Context) -> ?nif_stub.
+sha(Data) ->
+ hash(sha, Data).
+sha_init() ->
+ hash_init(sha).
+sha_update(Context, Data) ->
+ hash_update(Context, Data).
+sha_final(Context) ->
+ hash_final(Context).
%% HMAC --------------------------------------------------------------------
-hmac(Type, Key, Data, MacSize, Size, MaxBytes, initial) when Size =< MaxBytes ->
+hmac(Type, Key, Data, MacSize, Size, MaxBytes) when Size =< MaxBytes ->
+ notsup_to_error(
case MacSize of
- undefined ->
- do_hmac(Type, Key, Data);
- _ ->
- do_hmac(Type, Key, Data, MacSize)
- end;
-hmac(Type, Key, Data, MacSize, _, MaxBytes, initial) ->
- <<Increment:MaxBytes/binary, Rest/binary>> = Data,
+ undefined -> hmac_nif(Type, Key, Data);
+ _ -> hmac_nif(Type, Key, Data, MacSize)
+ end);
+hmac(Type, Key, Data, MacSize, Size, MaxBytes) ->
State0 = hmac_init(Type, Key),
- State = hmac_update(State0, Increment),
- hmac(State, Rest, MacSize, erlang:byte_size(Rest), max_bytes(), continue).
-hmac(State0, Data, MacSize, Size, MaxBytes, continue) when Size =< MaxBytes ->
- State = hmac_update(State0, Data),
+ State1 = hmac_update(State0, Data, Size, MaxBytes),
case MacSize of
- undefined ->
- hmac_final(State);
- _ ->
- hmac_final_n(State, MacSize)
- end;
-hmac(State0, Data, MacSize, _Size, MaxBytes, continue) ->
- <<Increment:MaxBytes/binary, Rest/binary>> = Data,
- State = hmac_update(State0, Increment),
- hmac(State, Rest, MacSize, erlang:byte_size(Rest), max_bytes(), continue).
+ undefined -> hmac_final(State1);
+ _ -> hmac_final_n(State1, MacSize)
+ end.
hmac_update(State, Data, Size, MaxBytes) when Size =< MaxBytes ->
- do_hmac_update(State, Data);
+ notsup_to_error(hmac_update_nif(State, Data));
hmac_update(State0, Data, _, MaxBytes) ->
<<Increment:MaxBytes/binary, Rest/binary>> = Data,
- State = do_hmac_update(State0, Increment),
+ State = notsup_to_error(hmac_update_nif(State0, Increment)),
hmac_update(State, Rest, erlang:byte_size(Rest), MaxBytes).
-do_hmac(md5, Key, Data) -> md5_mac(Key, Data);
-do_hmac(sha, Key, Data) -> sha_mac(Key, Data);
-do_hmac(sha224, Key, Data) -> sha224_mac(Key, Data);
-do_hmac(sha256, Key, Data) -> sha256_mac(Key, Data);
-do_hmac(sha384, Key, Data) -> sha384_mac(Key, Data);
-do_hmac(sha512, Key, Data) -> sha512_mac(Key, Data).
-
-do_hmac(md5, Key, Data, Size) -> md5_mac_n(Key, Data, Size);
-do_hmac(sha, Key, Data, Size) -> sha_mac_n(Key, Data, Size);
-do_hmac(sha224, Key, Data, Size) -> sha224_mac(Key, Data, Size);
-do_hmac(sha256, Key, Data, Size) -> sha256_mac(Key, Data, Size);
-do_hmac(sha384, Key, Data, Size) -> sha384_mac(Key, Data, Size);
-do_hmac(sha512, Key, Data, Size) -> sha512_mac(Key, Data, Size).
-
-do_hmac_update(_Context, _Data) -> ? nif_stub.
+hmac_nif(_Type, _Key, _Data) -> ?nif_stub.
+hmac_nif(_Type, _Key, _Data, _MacSize) -> ?nif_stub.
+hmac_init_nif(_Type, _Key) -> ?nif_stub.
+hmac_update_nif(_Context, _Data) -> ?nif_stub.
+hmac_final_nif(_Context) -> ?nif_stub.
+hmac_final_nif(_Context, _MacSize) -> ?nif_stub.
%%
%% MD5_MAC
@@ -1002,97 +795,37 @@ do_hmac_update(_Context, _Data) -> ? nif_stub.
-spec md5_mac(iodata(), iodata()) -> binary().
-spec md5_mac_96(iodata(), iodata()) -> binary().
-md5_mac(Key, Data) ->
- md5_mac_n(Key,Data,16).
+md5_mac(Key, Data) -> hmac(md5, Key, Data).
-md5_mac_96(Key, Data) ->
- md5_mac_n(Key,Data,12).
+md5_mac_96(Key, Data) -> hmac(md5, Key, Data, 12).
-md5_mac_n(_Key,_Data,_MacSz) -> ?nif_stub.
-
%%
%% SHA_MAC
%%
-spec sha_mac(iodata(), iodata()) -> binary().
-spec sha_mac_96(iodata(), iodata()) -> binary().
-sha_mac(Key, Data) ->
- sha_mac_n(Key,Data,20).
-
-sha_mac(Key, Data, Size) ->
- sha_mac_n(Key, Data, Size).
+sha_mac(Key, Data) -> hmac(sha, Key, Data).
-sha_mac_96(Key, Data) ->
- sha_mac_n(Key,Data,12).
-
-sha_mac_n(_Key,_Data,_MacSz) -> ?nif_stub.
-
-%%
-%% SHA224_MAC
-%%
--spec sha224_mac(iodata(), iodata()) -> binary().
+sha_mac(Key, Data, Size) -> hmac(sha, Key, Data, Size).
-sha224_mac(Key, Data) ->
- sha224_mac(Key, Data, 224 div 8).
+sha_mac_96(Key, Data) -> hmac(sha, Key, Data, 12).
-sha224_mac(Key, Data, Size) ->
- case sha224_mac_nif(Key, Data, Size) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-
-sha224_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub.
-
-%%
-%% SHA256_MAC
-%%
--spec sha256_mac(iodata(), iodata()) -> binary().
-
-sha256_mac(Key, Data) ->
- sha256_mac(Key, Data, 256 div 8).
-
-sha256_mac(Key, Data, Size) ->
- case sha256_mac_nif(Key, Data, Size) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-
-sha256_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub.
-
-%%
-%% SHA384_MAC
-%%
--spec sha384_mac(iodata(), iodata()) -> binary().
-
-sha384_mac(Key, Data) ->
- sha384_mac(Key, Data, 384 div 8).
-
-sha384_mac(Key, Data, Size) ->
- case sha384_mac_nif(Key, Data, Size) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-
-sha384_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub.
-
-%%
-%% SHA512_MAC
-%%
--spec sha512_mac(iodata(), iodata()) -> binary().
-
-sha512_mac(Key, Data) ->
- sha512_mac(Key, Data, 512 div 8).
+%% CIPHERS --------------------------------------------------------------------
-sha512_mac(Key, Data, MacSz) ->
- case sha512_mac_nif(Key, Data, MacSz) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
+block_crypt_nif(_Type, _Key, _Ivec, _Text, _IsEncrypt) -> ?nif_stub.
+block_crypt_nif(_Type, _Key, _Text, _IsEncrypt) -> ?nif_stub.
+
+check_des3_key(Key) ->
+ case lists:map(fun erlang:iolist_to_binary/1, Key) of
+ ValidKey = [B1, B2, B3] when byte_size(B1) =:= 8,
+ byte_size(B2) =:= 8,
+ byte_size(B3) =:= 8 ->
+ ValidKey;
+ _ ->
+ error(badarg)
end.
-sha512_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub.
-
-%% CIPHERS --------------------------------------------------------------------
-
%%
%% DES - in electronic codebook mode (ECB)
%%
@@ -1100,10 +833,9 @@ sha512_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub.
-spec des_ecb_decrypt(iodata(), iodata()) -> binary().
des_ecb_encrypt(Key, Data) ->
- des_ecb_crypt(Key, Data, true).
+ block_encrypt(des_ecb, Key, Data).
des_ecb_decrypt(Key, Data) ->
- des_ecb_crypt(Key, Data, false).
-des_ecb_crypt(_Key, _Data, _IsEncrypt) -> ?nif_stub.
+ block_decrypt(des_ecb, Key, Data).
%%
%% DES3 - in cipher block chaining mode (CBC)
@@ -1114,16 +846,14 @@ des_ecb_crypt(_Key, _Data, _IsEncrypt) -> ?nif_stub.
binary().
des3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) ->
- des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, true).
+ block_encrypt(des3_cbc, [Key1, Key2, Key3], IVec, Data).
des_ede3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) ->
- des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, true).
+ block_encrypt(des_ede3, [Key1, Key2, Key3], IVec, Data).
des3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) ->
- des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, false).
+ block_decrypt(des3_cbc, [Key1, Key2, Key3], IVec, Data).
des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) ->
- des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, false).
-
-des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+ block_decrypt(des_ede3, [Key1, Key2, Key3], IVec, Data).
%%
%% DES3 - in 8-bits cipher feedback mode (CFB)
@@ -1134,18 +864,10 @@ des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
binary().
des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) ->
- des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, true).
+ block_encrypt(des3_cbf, [Key1, Key2, Key3], IVec, Data).
des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) ->
- des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, false).
-
-des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, IsEncrypt) ->
- case des_ede3_cfb_crypt_nif(Key1,Key2,Key3,IVec,Data,IsEncrypt) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-
-des_ede3_cfb_crypt_nif(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+ block_decrypt(des3_cbf, [Key1, Key2, Key3], IVec, Data).
%%
%% Blowfish
@@ -1159,62 +881,38 @@ des_ede3_cfb_crypt_nif(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_st
-spec blowfish_ofb64_encrypt(iodata(), binary(), iodata()) -> binary().
blowfish_ecb_encrypt(Key, Data) ->
- bf_ecb_crypt(Key,Data, true).
+ block_encrypt(blowfish_ecb, Key, Data).
blowfish_ecb_decrypt(Key, Data) ->
- bf_ecb_crypt(Key,Data, false).
-
-bf_ecb_crypt(_Key,_Data,_IsEncrypt) -> ?nif_stub.
+ block_decrypt(blowfish_ecb, Key, Data).
blowfish_cbc_encrypt(Key, IVec, Data) ->
- bf_cbc_crypt(Key,IVec,Data,true).
+ block_encrypt(blowfish_cbc, Key, IVec, Data).
blowfish_cbc_decrypt(Key, IVec, Data) ->
- bf_cbc_crypt(Key,IVec,Data,false).
-
-bf_cbc_crypt(_Key,_IVec,_Data,_IsEncrypt) -> ?nif_stub.
+ block_decrypt(blowfish_cbc, Key, IVec, Data).
blowfish_cfb64_encrypt(Key, IVec, Data) ->
- bf_cfb64_crypt(Key, IVec, Data, true).
+ block_encrypt(blowfish_cfb64, Key, IVec, Data).
blowfish_cfb64_decrypt(Key, IVec, Data) ->
- bf_cfb64_crypt(Key, IVec, Data, false).
-
-bf_cfb64_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
-
-blowfish_ofb64_decrypt(Key, Ivec, Data) ->
- blowfish_ofb64_encrypt(Key, Ivec, Data).
+ block_decrypt(blowfish_cfb64, Key, IVec, Data).
-blowfish_ofb64_encrypt(_Key, _IVec, _Data) -> ?nif_stub.
+blowfish_ofb64_encrypt(Key, IVec, Data) ->
+ block_encrypt(blowfish_ofb64, Key, IVec, Data).
%%
-%% AES in cipher feedback mode (CFB) - 8 bit shift
-%%
--spec aes_cfb_8_encrypt(iodata(), binary(), iodata()) -> binary().
--spec aes_cfb_8_decrypt(iodata(), binary(), iodata()) -> binary().
-
-aes_cfb_8_encrypt(Key, IVec, Data) ->
- aes_cfb_8_crypt(Key, IVec, Data, true).
-
-aes_cfb_8_decrypt(Key, IVec, Data) ->
- aes_cfb_8_crypt(Key, IVec, Data, false).
-
-aes_cfb_8_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
-
-%%
%% AES in cipher feedback mode (CFB) - 128 bit shift
%%
-spec aes_cfb_128_encrypt(iodata(), binary(), iodata()) -> binary().
-spec aes_cfb_128_decrypt(iodata(), binary(), iodata()) -> binary().
aes_cfb_128_encrypt(Key, IVec, Data) ->
- aes_cfb_128_crypt(Key, IVec, Data, true).
+ block_encrypt(aes_cfb128, Key, IVec, Data).
aes_cfb_128_decrypt(Key, IVec, Data) ->
- aes_cfb_128_crypt(Key, IVec, Data, false).
-
-aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+ block_decrypt(aes_cfb128, Key, IVec, Data).
%%
%% AES - in Galois/Counter Mode (GCM)
@@ -1235,12 +933,10 @@ chacha20_poly1305_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub.
-spec des_cbc_decrypt(iodata(), binary(), iodata()) -> binary().
des_cbc_encrypt(Key, IVec, Data) ->
- des_cbc_crypt(Key, IVec, Data, true).
+ block_encrypt(des_cbc, Key, IVec, Data).
des_cbc_decrypt(Key, IVec, Data) ->
- des_cbc_crypt(Key, IVec, Data, false).
-
-des_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+ block_decrypt(des_cbc, Key, IVec, Data).
%%
%% dec_cbc_ivec(Data) -> binary()
@@ -1250,11 +946,8 @@ des_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
%%
-spec des_cbc_ivec(iodata()) -> binary().
-des_cbc_ivec(Data) when is_binary(Data) ->
- {_, IVec} = split_binary(Data, size(Data) - 8),
- IVec;
-des_cbc_ivec(Data) when is_list(Data) ->
- des_cbc_ivec(list_to_binary(Data)).
+des_cbc_ivec(Data) ->
+ next_iv(des_cbc, Data).
%%
%% DES - in 8-bits cipher feedback mode (CFB)
@@ -1263,12 +956,10 @@ des_cbc_ivec(Data) when is_list(Data) ->
-spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary().
des_cfb_encrypt(Key, IVec, Data) ->
- des_cfb_crypt(Key, IVec, Data, true).
+ block_encrypt(des_cfb, Key, IVec, Data).
des_cfb_decrypt(Key, IVec, Data) ->
- des_cfb_crypt(Key, IVec, Data, false).
-
-des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+ block_decrypt(des_cfb, Key, IVec, Data).
%%
%% dec_cfb_ivec(IVec, Data) -> binary()
@@ -1280,9 +971,7 @@ des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
-spec des_cfb_ivec(iodata(), iodata()) -> binary().
des_cfb_ivec(IVec, Data) ->
- IVecAndData = list_to_binary([IVec, Data]),
- {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8),
- NewIVec.
+ next_iv(des_cfb, Data, IVec).
%%
@@ -1298,18 +987,16 @@ des_cfb_ivec(IVec, Data) ->
binary().
aes_cbc_128_encrypt(Key, IVec, Data) ->
- aes_cbc_crypt(Key, IVec, Data, true).
+ block_encrypt(aes_cbc128, Key, IVec, Data).
aes_cbc_128_decrypt(Key, IVec, Data) ->
- aes_cbc_crypt(Key, IVec, Data, false).
+ block_decrypt(aes_cbc128, Key, IVec, Data).
aes_cbc_256_encrypt(Key, IVec, Data) ->
- aes_cbc_crypt(Key, IVec, Data, true).
+ block_encrypt(aes_cbc256, Key, IVec, Data).
aes_cbc_256_decrypt(Key, IVec, Data) ->
- aes_cbc_crypt(Key, IVec, Data, false).
-
-aes_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+ block_decrypt(aes_cbc256, Key, IVec, Data).
%%
%% aes_cbc_ivec(Data) -> binary()
@@ -1318,47 +1005,15 @@ aes_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
%% aes_cbc_*_[encrypt|decrypt].
%% IVec size: 16 bytes
%%
-aes_cbc_ivec(Data) when is_binary(Data) ->
- {_, IVec} = split_binary(Data, size(Data) - 16),
- IVec;
-aes_cbc_ivec(Data) when is_list(Data) ->
- aes_cbc_ivec(list_to_binary(Data)).
-
+aes_cbc_ivec(Data) ->
+ next_iv(aes_cbc, Data).
%%
%% AES - with 256 bit key in infinite garble extension mode (IGE)
%%
--spec aes_ige_256_decrypt(iodata(), binary(), iodata()) ->
- binary().
-
-aes_ige_256_encrypt(Key, IVec, Data) ->
- aes_ige_crypt(Key, IVec, Data, true).
-
-aes_ige_256_decrypt(Key, IVec, Data) ->
- aes_ige_crypt(Key, IVec, Data, false).
-
-aes_ige_crypt(Key, IVec, Data, IsEncrypt) ->
- case aes_ige_crypt_nif(Key,IVec,Data,IsEncrypt) of
- notsup -> erlang:error(notsup);
- Bin -> Bin
- end.
-
aes_ige_crypt_nif(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
-%%
-%% aes_ige_ivec(Data) -> binary()
-%%
-%% Returns the IVec to be used in the next iteration of
-%% aes_ige_*_[encrypt|decrypt].
-%% IVec size: 32 bytes
-%%
-aes_ige_ivec(Data) when is_binary(Data) ->
- {_, IVec} = split_binary(Data, size(Data) - 32),
- IVec;
-aes_ige_ivec(Data) when is_list(Data) ->
- aes_ige_ivec(list_to_binary(Data)).
-
%% Stream ciphers --------------------------------------------------------------------
@@ -1397,22 +1052,11 @@ do_stream_decrypt({rc4, State0}, Data) ->
aes_ctr_encrypt(_Key, _IVec, _Data) -> ?nif_stub.
aes_ctr_decrypt(_Key, _IVec, _Cipher) -> ?nif_stub.
-%%
-%% AES - in electronic codebook mode (ECB)
-%%
-aes_ecb_encrypt(Key, Data) ->
- aes_ecb_crypt(Key, Data, true).
-
-aes_ecb_decrypt(Key, Data) ->
- aes_ecb_crypt(Key, Data, false).
-
-aes_ecb_crypt(_Key, __Data, _IsEncrypt) -> ?nif_stub.
-
%%
%% AES - in counter mode (CTR) with state maintained for multi-call streaming
%%
--type ctr_state() :: { iodata(), binary(), binary(), integer() }.
+-type ctr_state() :: { iodata(), binary(), binary(), integer() } | binary().
-spec aes_ctr_stream_init(iodata(), binary()) -> ctr_state().
-spec aes_ctr_stream_encrypt(ctr_state(), binary()) ->
@@ -1420,10 +1064,9 @@ aes_ecb_crypt(_Key, __Data, _IsEncrypt) -> ?nif_stub.
-spec aes_ctr_stream_decrypt(ctr_state(), binary()) ->
{ ctr_state(), binary() }.
-aes_ctr_stream_init(Key, IVec) ->
- {Key, IVec, << 0:128 >>, 0}.
-aes_ctr_stream_encrypt({_Key, _IVec, _ECount, _Num}=_State, _Data) -> ?nif_stub.
-aes_ctr_stream_decrypt({_Key, _IVec, _ECount, _Num}=_State, _Cipher) -> ?nif_stub.
+aes_ctr_stream_init(_Key, _IVec) -> ?nif_stub.
+aes_ctr_stream_encrypt(_State, _Data) -> ?nif_stub.
+aes_ctr_stream_decrypt(_State, _Cipher) -> ?nif_stub.
%%
%% RC4 - symmetric stream cipher
@@ -1438,21 +1081,19 @@ rc4_encrypt_with_state(_State, _Data) -> ?nif_stub.
%% RC2 block cipher
rc2_cbc_encrypt(Key, IVec, Data) ->
- rc2_cbc_crypt(Key,IVec,Data,true).
+ block_encrypt(rc2_cbc, Key, IVec, Data).
rc2_cbc_decrypt(Key, IVec, Data) ->
- rc2_cbc_crypt(Key,IVec,Data,false).
-
-rc2_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+ block_decrypt(rc2_cbc, Key, IVec, Data).
%%
%% RC2 - 40 bits block cipher - Backwards compatibility not documented.
%%
rc2_40_cbc_encrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 ->
- rc2_cbc_crypt(Key,IVec,Data,true).
+ block_encrypt(rc2_cbc, Key, IVec, Data).
rc2_40_cbc_decrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 ->
- rc2_cbc_crypt(Key,IVec,Data,false).
+ block_decrypt(rc2_cbc, Key, IVec, Data).
%% Secure remote password -------------------------------------------------------------------
@@ -1470,16 +1111,18 @@ host_srp_gen_key(Private, Verifier, Generator, Prime, Version) ->
case srp_value_B_nif(Multiplier, Verifier, Generator, Private, Prime) of
error ->
error;
+ notsup ->
+ erlang:error(notsup);
Public ->
{Public, Private}
end.
srp_multiplier('6a', Generator, Prime) ->
%% k = SHA1(N | PAD(g)) from http://srp.stanford.edu/design.html
- C0 = sha_init(),
- C1 = sha_update(C0, Prime),
- C2 = sha_update(C1, srp_pad_to(erlang:byte_size(Prime), Generator)),
- sha_final(C2);
+ C0 = hash_init(sha),
+ C1 = hash_update(C0, Prime),
+ C2 = hash_update(C1, srp_pad_to(erlang:byte_size(Prime), Generator)),
+ hash_final(C2);
srp_multiplier('6', _, _) ->
<<3/integer>>;
srp_multiplier('3', _, _) ->
@@ -1488,10 +1131,10 @@ srp_multiplier('3', _, _) ->
srp_scrambler(Version, UserPublic, HostPublic, Prime) when Version == '6'; Version == '6a'->
%% SHA1(PAD(A) | PAD(B)) from http://srp.stanford.edu/design.html
PadLength = erlang:byte_size(Prime),
- C0 = sha_init(),
- C1 = sha_update(C0, srp_pad_to(PadLength, UserPublic)),
- C2 = sha_update(C1, srp_pad_to(PadLength, HostPublic)),
- sha_final(C2);
+ C0 = hash_init(sha),
+ C1 = hash_update(C0, srp_pad_to(PadLength, UserPublic)),
+ C2 = hash_update(C1, srp_pad_to(PadLength, HostPublic)),
+ hash_final(C2);
srp_scrambler('3', _, HostPublic, _Prime) ->
%% The parameter u is a 32-bit unsigned integer which takes its value
%% from the first 32 bits of the SHA1 hash of B, MSB first.
@@ -1515,13 +1158,13 @@ srp_value_B_nif(_Multiplier, _Verifier, _Generator, _Exponent, _Prime) -> ?nif_s
%% Digital signatures --------------------------------------------------------------------
-rsa_sign_nif(_Type,_Data,_Key) -> ?nif_stub.
-dss_sign_nif(_Type,_Data,_Key) -> ?nif_stub.
-ecdsa_sign_nif(_Type, _DataOrDigest, _Curve, _Key) -> ?nif_stub.
+rsa_sign_nif(_Type,_Digest,_Key) -> ?nif_stub.
+dss_sign_nif(_Type,_Digest,_Key) -> ?nif_stub.
+ecdsa_sign_nif(_Type, _Digest, _Curve, _Key) -> ?nif_stub.
-dss_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub.
-rsa_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub.
-ecdsa_verify_nif(_Type, _DataOrDigest, _Signature, _Curve, _Key) -> ?nif_stub.
+dss_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub.
+rsa_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub.
+ecdsa_verify_nif(_Type, _Digest, _Signature, _Curve, _Key) -> ?nif_stub.
%% Public Keys --------------------------------------------------------------------
%% DH Diffie-Hellman functions
diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile
index 07e5c1b754..928a1b1d73 100644
--- a/lib/crypto/test/Makefile
+++ b/lib/crypto/test/Makefile
@@ -28,7 +28,7 @@ RELSYSDIR = $(RELEASE_PATH)/crypto_test
# FLAGS
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile)
diff --git a/lib/crypto/test/blowfish_SUITE.erl b/lib/crypto/test/blowfish_SUITE.erl
index b0d6954820..19f60450e9 100644
--- a/lib/crypto/test/blowfish_SUITE.erl
+++ b/lib/crypto/test/blowfish_SUITE.erl
@@ -24,8 +24,7 @@
%% Note: This directive should only be used in test suites.
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
--include("test_server_line.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(TIMEOUT, 120000). % 2 min
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 307fc4b019..f34d27649a 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -66,6 +66,7 @@ all() ->
{group, aes_ctr},
{group, aes_gcm},
{group, chacha20_poly1305},
+ {group, aes_cbc},
mod_pow,
exor,
rand_uniform
@@ -107,7 +108,8 @@ groups() ->
{rc4, [], [stream]},
{aes_ctr, [], [stream]},
{aes_gcm, [], [aead]},
- {chacha20_poly1305, [], [aead]}
+ {chacha20_poly1305, [], [aead]},
+ {aes_cbc, [], [block]}
].
%%-------------------------------------------------------------------
@@ -118,10 +120,10 @@ init_per_suite(Config) ->
_ ->
Config
catch error:low_entropy ->
- %% Make sure we are on OSE, otherwise we want to crash
- {ose,_} = os:type(),
+ %% We are testing on an OS with low entropy in its random
+ %% seed. So we have to seed it with a binary to get started.
- %% This is NOT how you want to seed this, it is just here
+ %% This is NOT how you want to do seeding, it is just here
%% to make the tests pass. Check your OS manual for how you
%% really want to seed.
{H,M,L} = erlang:now(),
@@ -363,6 +365,21 @@ block_cipher({Type, Key, IV, PlainText}) ->
ok;
Other ->
ct:fail({{crypto, block_decrypt, [Type, Key, IV, CipherText]}, {expected, Plain}, {got, Other}})
+ end;
+
+block_cipher({Type, Key, IV, PlainText, CipherText}) ->
+ Plain = iolist_to_binary(PlainText),
+ case crypto:block_encrypt(Type, Key, IV, Plain) of
+ CipherText ->
+ ok;
+ Other0 ->
+ ct:fail({{crypto, block_encrypt, [Type, Key, IV, Plain]}, {expected, CipherText}, {got, Other0}})
+ end,
+ case crypto:block_decrypt(Type, Key, IV, CipherText) of
+ Plain ->
+ ok;
+ Other1 ->
+ ct:fail({{crypto, block_decrypt, [Type, Key, IV, CipherText]}, {expected, Plain}, {got, Other1}})
end.
block_cipher_increment({Type, Key, IV, PlainTexts}) when Type == des_cbc;
@@ -370,7 +387,11 @@ block_cipher_increment({Type, Key, IV, PlainTexts}) when Type == des_cbc;
Type == aes_cbc;
Type == des_cbf
->
- block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), []);
+ block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), []);
+block_cipher_increment({Type, Key, IV, PlainTexts, _CipherText}) when Type == aes_cbc ->
+ Plain = iolist_to_binary(PlainTexts),
+ Blocks = [iolistify(Block) || << Block:128/bitstring >> <= Plain],
+ block_cipher_increment(Type, Key, IV, IV, Blocks, Plain, []);
block_cipher_increment({_Type, _, _, _}) ->
ok;
block_cipher_increment({_,_,_}) ->
@@ -552,7 +573,9 @@ do_block_iolistify({des_ede3 = Type, Key, IV, PlainText}) ->
do_block_iolistify({Type, Key, PlainText}) ->
{Type, iolistify(Key), iolistify(PlainText)};
do_block_iolistify({Type, Key, IV, PlainText}) ->
- {Type, iolistify(Key), IV, iolistify(PlainText)}.
+ {Type, iolistify(Key), IV, iolistify(PlainText)};
+do_block_iolistify({Type, Key, IV, PlainText, CipherText}) ->
+ {Type, iolistify(Key), IV, iolistify(PlainText), CipherText}.
iolistify(<<"Test With Truncation">>)->
%% Do not iolistify as it spoils this special case
@@ -803,6 +826,9 @@ group_config(aes_gcm, Config) ->
group_config(chacha20_poly1305, Config) ->
AEAD = chacha20_poly1305(),
[{aead, AEAD} | Config];
+group_config(aes_cbc, Config) ->
+ Block = aes_cbc(),
+ [{block, Block} | Config];
group_config(_, Config) ->
Config.
@@ -1166,6 +1192,50 @@ rc2_cbc() ->
<<72,91,135,182,25,42,35,210>>,
<<36,245,206,158,168,230,58,69,148,137,32,192,250,41,237,181,181,251, 192,2,175,135,177,171,57,30,111,117,159,149,15,28,88,158,28,81,28,115, 85,219,241,82,117,222,91,85,73,117,164,25,182,52,191,64,123,57,26,19, 211,27,253,31,194,219,231,104,247,240,172,130,119,21,225,154,101,247, 32,216,42,216,133,169,78,22,97,27,227,26,196,224,172,168,17,9,148,55, 203,91,252,40,61,226,236,221,215,160,78,63,13,181,68,57,196,241,185, 207, 116,129,152,237,60,139,247,153,27,146,161,246,222,98,185,222,152, 187,135, 236,86,34,7,110,91,230,173,34,160,242,202,222,121,127,181,140, 101,203,195, 190,88,250,86,147,127,87,72,126,171,16,71,47,110,248,88, 14,29,143,161,152, 129,236,148,22,152,186,208,119,70,8,174,193,203,100, 193,203,200,117,102,242, 134,142,96,125,135,200,217,190,76,117,50,70, 209,186,101,241,200,91,40,193,54, 90,195,38,47,59,197,38,234,86,223,16, 51,253,204,129,20,171,66,21,241,26,135,216, 196,114,110,91,15,53,40, 164,201,136,113,95,247,51,181,208,241,68,168,98,151,36, 155,72,24,57, 42,191,14,125,204,10,167,214,233,138,115,125,234,121,134,227,26,247, 77,200,117,110,117,111,168,156,206,67,159,149,189,173,150,193,91,199, 216,153,22, 189,137,185,89,160,13,131,132,58,109,28,110,246,252,251,14, 232,91,38,52,29,101,188,69,123,50,0,130,178,93,73,239,118,7,77,35,59, 253,10,159,45,86,142,37,78,232,48>>
}].
+
+%% AES CBC test vectors from http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf
+aes_cbc() ->
+ [
+ %% F.2.1 CBC-AES128.Encrypt, F.2.2 CBC-AES128.Decrypt
+ {aes_cbc,
+ hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), %% Key
+ hexstr2bin("000102030405060708090a0b0c0d0e0f"), %% IV
+ hexstr2bin("6bc1bee22e409f96e93d7e117393172a" %% PlainText
+ "ae2d8a571e03ac9c9eb76fac45af8e51"
+ "30c81c46a35ce411e5fbc1191a0a52ef"
+ "f69f2445df4f9b17ad2b417be66c3710"),
+ hexstr2bin("7649abac8119b246cee98e9b12e9197d" %% CipherText
+ "5086cb9b507219ee95db113a917678b2"
+ "73bed6b8e3c1743b7116e69e22229516"
+ "3ff1caa1681fac09120eca307586e1a7")},
+ %% F.2.3 CBC-AES192.Encrypt, F.2.4 CBC-AES192.Decrypt
+ {aes_cbc,
+ hexstr2bin("8e73b0f7da0e6452c810f32b809079e5" %% Key
+ "62f8ead2522c6b7b"),
+ hexstr2bin("000102030405060708090a0b0c0d0e0f"), %% IV
+ hexstr2bin("6bc1bee22e409f96e93d7e117393172a" %% PlainText
+ "ae2d8a571e03ac9c9eb76fac45af8e51"
+ "30c81c46a35ce411e5fbc1191a0a52ef"
+ "f69f2445df4f9b17ad2b417be66c3710"),
+ hexstr2bin("4f021db243bc633d7178183a9fa071e8" %% CipherText
+ "b4d9ada9ad7dedf4e5e738763f69145a"
+ "571b242012fb7ae07fa9baac3df102e0"
+ "08b0e27988598881d920a9e64f5615cd")},
+ %% F.2.5 CBC-AES256.Encrypt, F.2.6 CBC-AES256.Decrypt
+ {aes_cbc,
+ hexstr2bin("603deb1015ca71be2b73aef0857d7781" %% Key
+ "1f352c073b6108d72d9810a30914dff4"),
+ hexstr2bin("000102030405060708090a0b0c0d0e0f"), %% IV
+ hexstr2bin("6bc1bee22e409f96e93d7e117393172a" %% PlainText
+ "ae2d8a571e03ac9c9eb76fac45af8e51"
+ "30c81c46a35ce411e5fbc1191a0a52ef"
+ "f69f2445df4f9b17ad2b417be66c3710"),
+ hexstr2bin("f58c4c04d6e5f1ba779eabfb5f7bfbd6" %% CipherText
+ "9cfc4e967edb808d679f777bc6702c7d"
+ "39f23369a9d9bacfa530e26304231461"
+ "b2eb05e2c39be9fcda6c19078c6a9d1b")}
+ ].
+
aes_cbc128() ->
[{aes_cbc128,
hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
@@ -1310,6 +1380,14 @@ aes_ecb() ->
"ae2d8a571e03ac9c9eb76fac45af8e51"
"30c81c46a35ce411e5fbc1191a0a52ef"
"f69f2445df4f9b17ad2b417be66c3710")},
+ %% F.1.3 ECB-AES192.Encrypt, F.1.4 ECB-AES192.Decrypt
+ {aes_ecb,
+ hexstr2bin("8e73b0f7da0e6452c810f32b809079e5"
+ "62f8ead2522c6b7b"),
+ hexstr2bin("6bc1bee22e409f96e93d7e117393172a"
+ "ae2d8a571e03ac9c9eb76fac45af8e51"
+ "30c81c46a35ce411e5fbc1191a0a52ef"
+ "f69f2445df4f9b17ad2b417be66c3710")},
%% F.1.5 ECB-AES256.Encrypt, F.1.6 ECB-AES256.Decrypt
{aes_ecb,
hexstr2bin("603deb1015ca71be2b73aef0857d7781"
diff --git a/lib/crypto/test/old_crypto_SUITE.erl b/lib/crypto/test/old_crypto_SUITE.erl
index 1e7f3a1438..37cce2ebd2 100644
--- a/lib/crypto/test/old_crypto_SUITE.erl
+++ b/lib/crypto/test/old_crypto_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(old_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,
init_per_testcase/2,
diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl
index 2a8bcd32d8..369b456524 100644
--- a/lib/debugger/src/dbg_iload.erl
+++ b/lib/debugger/src/dbg_iload.erl
@@ -39,7 +39,7 @@
%% dbg_iserver. We are suspended until the module has been loaded.
%%--------------------------------------------------------------------
-spec load_mod(Mod, file:filename(), binary(), ets:tid()) ->
- {'ok', Mod} when is_subtype(Mod, atom()).
+ {'ok', Mod} when Mod :: atom().
load_mod(Mod, File, Binary, Db) ->
Flag = process_flag(trap_exit, true),
@@ -541,7 +541,7 @@ fun_clauses([]) -> [].
new_map(Fs0, Anno, F) ->
Line = ln(Anno),
Fs1 = map_fields(Fs0, F),
- Fs2 = [{ln(A),K,V} || {map_field_assoc,A,K,V} <- Fs1],
+ Fs2 = [{L,K,V} || {map_field_assoc,L,K,V} <- Fs1],
try
{value,Line,map_literal(Fs2, #{})}
catch
diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl
index 63f74392b5..1ff8818bbe 100644
--- a/lib/debugger/src/dbg_wx_win.erl
+++ b/lib/debugger/src/dbg_wx_win.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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.
@@ -95,10 +95,9 @@ create_menu_item(Menu, [{Name, _N, cascade, Items}|Is], Win, Id0,Connect) ->
false -> Acc
end
end,
- Filter = fun(_,_) ->
+ Filter = fun(Ev,_) ->
Enabled = lists:foldl(IsChecked, [], Butts),
- Self ! #wx{userData={Name, Enabled},
- event=#wxCommand{type=command_menu_selected}}
+ Self ! Ev#wx{userData={Name, Enabled}}
end,
wxMenu:connect(Win, command_menu_selected,
[{id,Id0},{lastId, Id-1},{callback,Filter}]),
diff --git a/lib/debugger/test/Makefile b/lib/debugger/test/Makefile
index 82f49c155f..1594c891b4 100644
--- a/lib/debugger/test/Makefile
+++ b/lib/debugger/test/Makefile
@@ -68,7 +68,7 @@ RELSYSDIR = $(RELEASE_PATH)/debugger_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/debugger/test/andor_SUITE.erl b/lib/debugger/test/andor_SUITE.erl
index 384b6c7c77..9750fa018d 100644
--- a/lib/debugger/test/andor_SUITE.erl
+++ b/lib/debugger/test/andor_SUITE.erl
@@ -27,7 +27,7 @@
t_andalso/1,t_orelse/1,inside/1,overlap/1,
combined/1,in_case/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/debugger/test/bs_bincomp_SUITE.erl b/lib/debugger/test/bs_bincomp_SUITE.erl
index 0750c6793d..18b4198354 100644
--- a/lib/debugger/test/bs_bincomp_SUITE.erl
+++ b/lib/debugger/test/bs_bincomp_SUITE.erl
@@ -30,7 +30,7 @@
byte_aligned/1,bit_aligned/1,extended_byte_aligned/1,
extended_bit_aligned/1,mixed/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(_Case, Config) ->
test_lib:interpret(?MODULE),
diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl
index f62512568f..966c096c3a 100644
--- a/lib/debugger/test/bs_construct_SUITE.erl
+++ b/lib/debugger/test/bs_construct_SUITE.erl
@@ -36,7 +36,7 @@
copy_writable_binary/1, dynamic/1,
otp_7422/1, zero_width/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/debugger/test/bs_match_bin_SUITE.erl b/lib/debugger/test/bs_match_bin_SUITE.erl
index a61b56501c..98c1013210 100644
--- a/lib/debugger/test/bs_match_bin_SUITE.erl
+++ b/lib/debugger/test/bs_match_bin_SUITE.erl
@@ -27,7 +27,7 @@
init_per_suite/1,end_per_suite/1,
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]}].
diff --git a/lib/debugger/test/bs_match_int_SUITE.erl b/lib/debugger/test/bs_match_int_SUITE.erl
index fd77530dd5..11b5e30efd 100644
--- a/lib/debugger/test/bs_match_int_SUITE.erl
+++ b/lib/debugger/test/bs_match_int_SUITE.erl
@@ -26,7 +26,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]).
diff --git a/lib/debugger/test/bs_match_misc_SUITE.erl b/lib/debugger/test/bs_match_misc_SUITE.erl
index 2221cfe08b..7196026dc7 100644
--- a/lib/debugger/test/bs_match_misc_SUITE.erl
+++ b/lib/debugger/test/bs_match_misc_SUITE.erl
@@ -29,7 +29,7 @@
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]}].
diff --git a/lib/debugger/test/bs_match_tail_SUITE.erl b/lib/debugger/test/bs_match_tail_SUITE.erl
index 9ec93978ed..f4201ee7db 100644
--- a/lib/debugger/test/bs_match_tail_SUITE.erl
+++ b/lib/debugger/test/bs_match_tail_SUITE.erl
@@ -26,7 +26,7 @@
init_per_suite/1,end_per_suite/1,
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]}].
diff --git a/lib/debugger/test/bs_utf_SUITE.erl b/lib/debugger/test/bs_utf_SUITE.erl
index 90c4d6c7b9..5bf776226a 100644
--- a/lib/debugger/test/bs_utf_SUITE.erl
+++ b/lib/debugger/test/bs_utf_SUITE.erl
@@ -28,7 +28,7 @@
utf8_roundtrip/1,unused_utf_char/1,utf16_roundtrip/1,
utf32_roundtrip/1,guard/1,extreme_tripping/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile([no_jopt,time]).
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/debugger/test/bug_SUITE.erl b/lib/debugger/test/bug_SUITE.erl
index 542db3f41e..516d9f4b8d 100644
--- a/lib/debugger/test/bug_SUITE.erl
+++ b/lib/debugger/test/bug_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(bug_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]).
diff --git a/lib/debugger/test/cleanup.erl b/lib/debugger/test/cleanup.erl
index b40ae5f82c..58f3c9380f 100644
--- a/lib/debugger/test/cleanup.erl
+++ b/lib/debugger/test/cleanup.erl
@@ -23,7 +23,7 @@
-export([all/0,groups/0,init_per_group/2,end_per_group/2, cleanup/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
all() ->
[cleanup].
diff --git a/lib/debugger/test/dbg_ui_SUITE.erl b/lib/debugger/test/dbg_ui_SUITE.erl
index f0f4e09aa8..39ecb51b57 100644
--- a/lib/debugger/test/dbg_ui_SUITE.erl
+++ b/lib/debugger/test/dbg_ui_SUITE.erl
@@ -22,7 +22,7 @@
-module(dbg_ui_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% Test server specific exports
diff --git a/lib/debugger/test/debugger_SUITE.erl b/lib/debugger/test/debugger_SUITE.erl
index 9207df38e4..678ca0e5c3 100644
--- a/lib/debugger/test/debugger_SUITE.erl
+++ b/lib/debugger/test/debugger_SUITE.erl
@@ -23,7 +23,7 @@
%% Test break points.
--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,
diff --git a/lib/debugger/test/erl_eval_SUITE.erl b/lib/debugger/test/erl_eval_SUITE.erl
index af9b0a6e6e..c75e4012f3 100644
--- a/lib/debugger/test/erl_eval_SUITE.erl
+++ b/lib/debugger/test/erl_eval_SUITE.erl
@@ -60,7 +60,7 @@
config(priv_dir,_) ->
".".
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init_per_testcase/2, end_per_testcase/2]).
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/debugger/test/exception_SUITE.erl b/lib/debugger/test/exception_SUITE.erl
index f42dbc7776..e35326a798 100644
--- a/lib/debugger/test/exception_SUITE.erl
+++ b/lib/debugger/test/exception_SUITE.erl
@@ -28,7 +28,7 @@
-export([bad_guy/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/debugger/test/fun_SUITE.erl b/lib/debugger/test/fun_SUITE.erl
index fabee16cee..b8092ab16c 100644
--- a/lib/debugger/test/fun_SUITE.erl
+++ b/lib/debugger/test/fun_SUITE.erl
@@ -30,7 +30,7 @@
%% Internal exports.
-export([nothing/0,call_me/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/debugger/test/guard_SUITE.erl b/lib/debugger/test/guard_SUITE.erl
index 880c89532b..2b87ef23ba 100644
--- a/lib/debugger/test/guard_SUITE.erl
+++ b/lib/debugger/test/guard_SUITE.erl
@@ -39,7 +39,7 @@
check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,
bad_constants/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init/4]).
-import(lists, [member/2]).
diff --git a/lib/debugger/test/int_SUITE.erl b/lib/debugger/test/int_SUITE.erl
index 5f2e4dd84d..8b16b7631b 100644
--- a/lib/debugger/test/int_SUITE.erl
+++ b/lib/debugger/test/int_SUITE.erl
@@ -20,7 +20,7 @@
%%
-module(int_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/debugger/test/int_break_SUITE.erl b/lib/debugger/test/int_break_SUITE.erl
index 21b53a8d30..75bdd69a7d 100644
--- a/lib/debugger/test/int_break_SUITE.erl
+++ b/lib/debugger/test/int_break_SUITE.erl
@@ -22,7 +22,7 @@
%% Test break points.
--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,
diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl
index f30d386de9..3f3c03492e 100644
--- a/lib/debugger/test/int_eval_SUITE.erl
+++ b/lib/debugger/test/int_eval_SUITE.erl
@@ -36,7 +36,7 @@
-define(IM, my_int_eval_module).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]},
{timetrap,{minutes,1}}].
diff --git a/lib/debugger/test/lc_SUITE.erl b/lib/debugger/test/lc_SUITE.erl
index aca4c4de7c..851d0fbc20 100644
--- a/lib/debugger/test/lc_SUITE.erl
+++ b/lib/debugger/test/lc_SUITE.erl
@@ -28,7 +28,7 @@
basic/1,deeply_nested/1,no_generator/1,
empty_generator/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/debugger/test/line_number_SUITE.erl b/lib/debugger/test/line_number_SUITE.erl
index 6ec5ef5d5a..592f0a1f32 100644
--- a/lib/debugger/test/line_number_SUITE.erl
+++ b/lib/debugger/test/line_number_SUITE.erl
@@ -26,7 +26,7 @@
line_numbers/1]).
-export([crash/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl
index 0ef634f7aa..eabcdcbf42 100644
--- a/lib/debugger/test/map_SUITE.erl
+++ b/lib/debugger/test/map_SUITE.erl
@@ -2219,7 +2219,7 @@ map_guard_sequence_mixed(K1,K2,M) ->
t_frequency_table(Config) when is_list(Config) ->
- random:seed({13,1337,54}), % pseudo random
+ rand:seed(exsplus, {13,1337,54}), % pseudo random
N = 1000,
Ts = rand_terms(N),
#{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}),
@@ -2262,7 +2262,7 @@ rand_terms(0) -> [];
rand_terms(N) -> [rand_term()|rand_terms(N-1)].
rand_term() ->
- case random:uniform(6) of
+ case rand:uniform(6) of
1 -> rand_binary();
2 -> rand_number();
3 -> rand_atom();
@@ -2272,21 +2272,21 @@ rand_term() ->
end.
rand_binary() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> <<>>;
2 -> <<"hi">>;
3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">>
end.
rand_number() ->
- case random:uniform(3) of
- 1 -> random:uniform(5);
- 2 -> float(random:uniform(5));
- 3 -> 1 bsl (63 + random:uniform(3))
+ case rand:uniform(3) of
+ 1 -> rand:uniform(5);
+ 2 -> float(rand:uniform(5));
+ 3 -> 1 bsl (63 + rand:uniform(3))
end.
rand_atom() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> hi;
2 -> some_atom;
3 -> some_other_atom
@@ -2294,21 +2294,21 @@ rand_atom() ->
rand_tuple() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> {ok, rand_term()}; % careful
2 -> {1, 2, 3};
3 -> {<<"yep">>, 1337}
end.
rand_list() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> "hi";
2 -> [1,rand_term()]; % careful
3 -> [improper|list]
end.
rand_map() ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 -> #{ hi => 3 };
2 -> #{ wat => rand_term(), other => 3 }; % careful
3 -> #{ hi => 42, other => 42, yet_anoter => 1337 }
diff --git a/lib/debugger/test/record_SUITE.erl b/lib/debugger/test/record_SUITE.erl
index 2f663e2dfc..115e65c685 100644
--- a/lib/debugger/test/record_SUITE.erl
+++ b/lib/debugger/test/record_SUITE.erl
@@ -23,7 +23,7 @@
-module(record_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_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
diff --git a/lib/debugger/test/trycatch_SUITE.erl b/lib/debugger/test/trycatch_SUITE.erl
index 7fdd98fc71..0303d1bd82 100644
--- a/lib/debugger/test/trycatch_SUITE.erl
+++ b/lib/debugger/test/trycatch_SUITE.erl
@@ -28,7 +28,7 @@
catch_oops/1,after_oops/1,eclectic/1,rethrow/1,
nested_of/1,nested_catch/1,nested_after/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml
index 3fd34241b2..619db125b1 100644
--- a/lib/dialyzer/doc/src/dialyzer.xml
+++ b/lib/dialyzer/doc/src/dialyzer.xml
@@ -254,7 +254,7 @@
analysis that finds data races performs intra-procedural data flow analysis
and can sometimes explode in time. Enable it at your own risk.
</item>
-i <tag><c><![CDATA[-Wunderspecs]]></c>***</tag>
+ <tag><c><![CDATA[-Wunderspecs]]></c>***</tag>
<item>Warn about underspecified functions
(the -spec is strictly more allowing than the success typing).</item>
<tag><c><![CDATA[-Wunknown]]></c>***</tag>
diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile
index 770af2140f..fd75cd5cd8 100644
--- a/lib/dialyzer/src/Makefile
+++ b/lib/dialyzer/src/Makefile
@@ -61,6 +61,7 @@ MODULES = \
dialyzer_gui_wx \
dialyzer_options \
dialyzer_plt \
+ dialyzer_race_data_server \
dialyzer_races \
dialyzer_succ_typings \
dialyzer_timing \
@@ -140,6 +141,7 @@ $(EBIN)/dialyzer_explanation.beam: dialyzer.hrl
$(EBIN)/dialyzer_gui_wx.beam: dialyzer.hrl dialyzer_gui_wx.hrl
$(EBIN)/dialyzer_options.beam: dialyzer.hrl
$(EBIN)/dialyzer_plt.beam: dialyzer.hrl
+$(EBIN)/dialyzer_race_data_server.beam: dialyzer.hrl
$(EBIN)/dialyzer_races.beam: dialyzer.hrl
$(EBIN)/dialyzer_succ_typings.beam: dialyzer.hrl
$(EBIN)/dialyzer_typesig.beam: dialyzer.hrl
diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src
index 8ac6dc1367..003d7f2ba4 100644
--- a/lib/dialyzer/src/dialyzer.app.src
+++ b/lib/dialyzer/src/dialyzer.app.src
@@ -37,6 +37,7 @@
dialyzer_gui_wx,
dialyzer_options,
dialyzer_plt,
+ dialyzer_race_data_server,
dialyzer_races,
dialyzer_succ_typings,
dialyzer_typesig,
@@ -44,7 +45,7 @@
dialyzer_timing,
dialyzer_worker]},
{registered, []},
- {applications, [compiler, gs, hipe, kernel, stdlib, wx]},
+ {applications, [compiler, hipe, kernel, stdlib, wx]},
{env, []},
{runtime_dependencies, ["wx-1.2","syntax_tools-1.6.14","stdlib-2.5",
"kernel-3.0","hipe-3.13","erts-7.0",
diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl
index de236f91ab..601e2e954b 100644
--- a/lib/dialyzer/src/dialyzer.hrl
+++ b/lib/dialyzer/src/dialyzer.hrl
@@ -2,7 +2,7 @@
%%%
%%% %CopyrightBegin%
%%%
-%%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
+%%% Copyright Ericsson AB 2006-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.
@@ -123,10 +123,12 @@
%% Record declarations used by various files
%%--------------------------------------------------------------------
--record(analysis, {analysis_pid :: pid(),
+-type doc_plt() :: 'undefined' | dialyzer_plt:plt().
+
+-record(analysis, {analysis_pid :: pid() | 'undefined',
type = succ_typings :: anal_type(),
defines = [] :: [dial_define()],
- doc_plt :: dialyzer_plt:plt(),
+ doc_plt :: doc_plt(),
files = [] :: [file:filename()],
include_dirs = [] :: [file:filename()],
start_from = byte_code :: start_from(),
@@ -135,7 +137,7 @@
race_detection = false :: boolean(),
behaviours_chk = false :: boolean(),
timing = false :: boolean() | 'debug',
- timing_server :: dialyzer_timing:timing_server(),
+ timing_server = none :: dialyzer_timing:timing_server(),
callgraph_file = "" :: file:filename(),
solvers :: [solver()]}).
diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
index 8537878dfc..50fc1d8471 100644
--- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -31,14 +31,17 @@
-export([start/3]).
+%%% Export for dialyzer_coordinator...
-export([compile_init_result/0,
- add_to_result/4,
- start_compilation/2,
+ add_to_result/4]).
+%%% ... and export for dialyzer_worker.
+-export([start_compilation/2,
continue_compilation/2]).
-export_type([compile_init_data/0,
- one_file_result/0,
- compile_result/0]).
+ one_file_mid_error/0,
+ one_file_result_ok/0,
+ compile_result/0]).
-include("dialyzer.hrl").
@@ -153,8 +156,7 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1),
TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0),
TmpCServer2 =
- dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes,
- TmpCServer1),
+ dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1),
?timing(State#analysis_state.timing_server, "remote",
begin
TmpCServer3 =
@@ -247,6 +249,10 @@ compile_and_store(Files, #analysis_state{codeserver = CServer,
{T1, _} = statistics(wall_clock),
Callgraph = dialyzer_callgraph:new(),
CompileInit = make_compile_init(State, Callgraph),
+ %% Spawn a worker per file - where each worker calls
+ %% start_compilation on its file, asks next label to coordinator and
+ %% calls continue_compilation - and let coordinator aggregate
+ %% results using (compile_init_result and) add_to_result.
{{Failed, Modules}, NextLabel} =
?timing(Timing, "compile", _C1,
dialyzer_coordinator:parallel_job(compile, Files,
@@ -278,16 +284,18 @@ compile_and_store(Files, #analysis_state{codeserver = CServer,
send_log(Parent, Msg2),
{Callgraph, CServer2}.
--type compile_init_data() :: #compile_init{}.
--type error_reason() :: string().
--type compile_result() :: {[{file:filename(), error_reason()}],
- [module()]}. %%opaque
--type one_file_result() :: {error, error_reason()} |
- {ok, [dialyzer_callgraph:callgraph_edge()],
- [mfa_or_funlbl()], module()}. %%opaque
--type compile_mid_data() :: {module(), cerl:cerl(),
- dialyzer_callgraph:callgraph(),
- dialyzer_codeserver:codeserver()}.
+-opaque compile_init_data() :: #compile_init{}.
+-type error_reason() :: string().
+-opaque compile_result() :: {[{file:filename(), error_reason()}],
+ [module()]}.
+-type one_file_mid_error() :: {error, error_reason()}.
+-opaque one_file_result_ok() :: {ok, [dialyzer_callgraph:callgraph_edge()],
+ [mfa_or_funlbl()], module()}.
+-type one_file_result() :: one_file_mid_error() |
+ one_file_result_ok().
+-type compile_mid_data() :: {module(), cerl:cerl(),
+ dialyzer_callgraph:callgraph(),
+ dialyzer_codeserver:codeserver()}.
-spec compile_init_result() -> compile_result().
@@ -428,7 +436,8 @@ store_core(Mod, Core, Callgraph, CServer) ->
CoreSize = cerl_trees:size(CoreTree),
{ok, CoreSize, {Mod, CoreTree, Callgraph, CServer}}.
--spec continue_compilation(integer(), compile_mid_data()) -> one_file_result().
+-spec continue_compilation(integer(), compile_mid_data()) ->
+ one_file_result_ok().
continue_compilation(NextLabel, {Mod, CoreTree, Callgraph, CServer}) ->
{LabeledTree, _NewNextLabel} = cerl_trees:label(CoreTree, NextLabel),
diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl
index 9e53e171c0..50abb22009 100644
--- a/lib/dialyzer/src/dialyzer_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_callgraph.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -96,26 +96,28 @@
%% whenever applicable.
%%-----------------------------------------------------------------------------
+%% Types with comment 'race' are due to dialyzer_races.erl.
-record(callgraph, {digraph = digraph:new() :: digraph:graph(),
- active_digraph :: active_digraph(),
- esc :: ets:tid(),
- letrec_map :: ets:tid(),
+ active_digraph :: active_digraph()
+ | 'undefined', % race
+ esc :: ets:tid()
+ | 'undefined', % race
+ letrec_map :: ets:tid()
+ | 'undefined', % race
name_map :: ets:tid(),
rev_name_map :: ets:tid(),
- rec_var_map :: ets:tid(),
- self_rec :: ets:tid(),
- calls :: ets:tid(),
+ rec_var_map :: ets:tid()
+ | 'undefined', % race
+ self_rec :: ets:tid()
+ | 'undefined', % race
+ calls :: ets:tid()
+ | 'undefined', % race
race_detection = false :: boolean(),
- race_data_server = new_race_data_server() :: pid()}).
-
--record(race_data_state, {race_code = dict:new() :: dict:dict(),
- public_tables = [] :: [label()],
- named_tables = [] :: [string()],
- beh_api_calls = [] :: [{mfa(), mfa()}]}).
+ race_data_server = dialyzer_race_data_server:new() :: pid()}).
%% Exported Types
--type callgraph() :: #callgraph{}.
+-opaque callgraph() :: #callgraph{}.
-type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}.
@@ -609,45 +611,30 @@ digraph_reaching_subgraph(Funs, DG) ->
renew_race_info(#callgraph{race_data_server = RaceDataServer} = CG,
RaceCode, PublicTables, NamedTables) ->
- ok = race_data_server_cast(
+ ok = dialyzer_race_data_server:cast(
{renew_race_info, {RaceCode, PublicTables, NamedTables}},
RaceDataServer),
CG.
-renew_race_info({RaceCode, PublicTables, NamedTables},
- #race_data_state{} = State) ->
- State#race_data_state{race_code = RaceCode,
- public_tables = PublicTables,
- named_tables = NamedTables}.
-
-spec renew_race_code(dialyzer_races:races(), callgraph()) -> callgraph().
renew_race_code(Races, #callgraph{race_data_server = RaceDataServer} = CG) ->
Fun = dialyzer_races:get_curr_fun(Races),
FunArgs = dialyzer_races:get_curr_fun_args(Races),
Code = lists:reverse(dialyzer_races:get_race_list(Races)),
- ok = race_data_server_cast(
+ ok = dialyzer_race_data_server:cast(
{renew_race_code, {Fun, FunArgs, Code}},
RaceDataServer),
CG.
-renew_race_code_handler({Fun, FunArgs, Code},
- #race_data_state{race_code = RaceCode} = State) ->
- State#race_data_state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}.
-
-spec renew_race_public_tables(label(), callgraph()) -> callgraph().
renew_race_public_tables(VarLabel,
#callgraph{race_data_server = RaceDataServer} = CG) ->
ok =
- race_data_server_cast({renew_race_public_tables, VarLabel}, RaceDataServer),
+ dialyzer_race_data_server:cast({renew_race_public_tables, VarLabel}, RaceDataServer),
CG.
-renew_race_public_tables_handler(VarLabel,
- #race_data_state{public_tables = PT}
- = State) ->
- State#race_data_state{public_tables = ordsets:add_element(VarLabel, PT)}.
-
-spec cleanup(callgraph()) -> callgraph().
cleanup(#callgraph{digraph = Digraph,
@@ -657,18 +644,18 @@ cleanup(#callgraph{digraph = Digraph,
#callgraph{digraph = Digraph,
name_map = NameMap,
rev_name_map = RevNameMap,
- race_data_server = race_data_server_call(dup, RaceDataServer)}.
+ race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}.
-spec duplicate(callgraph()) -> callgraph().
duplicate(#callgraph{race_data_server = RaceDataServer} = Callgraph) ->
Callgraph#callgraph{
- race_data_server = race_data_server_call(dup, RaceDataServer)}.
+ race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}.
-spec dispose_race_server(callgraph()) -> ok.
dispose_race_server(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_cast(stop, RaceDataServer).
+ dialyzer_race_data_server:stop(RaceDataServer).
-spec get_digraph(callgraph()) -> digraph:graph().
@@ -678,17 +665,17 @@ get_digraph(#callgraph{digraph = Digraph}) ->
-spec get_named_tables(callgraph()) -> [string()].
get_named_tables(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_call(get_named_tables, RaceDataServer).
+ dialyzer_race_data_server:call(get_named_tables, RaceDataServer).
-spec get_public_tables(callgraph()) -> [label()].
get_public_tables(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_call(get_public_tables, RaceDataServer).
+ dialyzer_race_data_server:call(get_public_tables, RaceDataServer).
-spec get_race_code(callgraph()) -> dict:dict().
get_race_code(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_call(get_race_code, RaceDataServer).
+ dialyzer_race_data_server:call(get_race_code, RaceDataServer).
-spec get_race_detection(callgraph()) -> boolean().
@@ -698,12 +685,12 @@ get_race_detection(#callgraph{race_detection = RD}) ->
-spec get_behaviour_api_calls(callgraph()) -> [{mfa(), mfa()}].
get_behaviour_api_calls(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_call(get_behaviour_api_calls, RaceDataServer).
+ dialyzer_race_data_server:call(get_behaviour_api_calls, RaceDataServer).
-spec race_code_new(callgraph()) -> callgraph().
race_code_new(#callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast(race_code_new, RaceDataServer),
+ ok = dialyzer_race_data_server:cast(race_code_new, RaceDataServer),
CG.
-spec put_digraph(digraph:graph(), callgraph()) -> callgraph().
@@ -714,7 +701,7 @@ put_digraph(Digraph, Callgraph) ->
-spec put_race_code(dict:dict(), callgraph()) -> callgraph().
put_race_code(RaceCode, #callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast({put_race_code, RaceCode}, RaceDataServer),
+ ok = dialyzer_race_data_server:cast({put_race_code, RaceCode}, RaceDataServer),
CG.
-spec put_race_detection(boolean(), callgraph()) -> callgraph().
@@ -726,78 +713,23 @@ put_race_detection(RaceDetection, Callgraph) ->
put_named_tables(NamedTables,
#callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast({put_named_tables, NamedTables}, RaceDataServer),
+ ok = dialyzer_race_data_server:cast({put_named_tables, NamedTables}, RaceDataServer),
CG.
-spec put_public_tables([label()], callgraph()) -> callgraph().
put_public_tables(PublicTables,
#callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast({put_public_tables, PublicTables}, RaceDataServer),
+ ok = dialyzer_race_data_server:cast({put_public_tables, PublicTables}, RaceDataServer),
CG.
-spec put_behaviour_api_calls([{mfa(), mfa()}], callgraph()) -> callgraph().
put_behaviour_api_calls(Calls,
#callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast({put_behaviour_api_calls, Calls}, RaceDataServer),
+ ok = dialyzer_race_data_server:cast({put_behaviour_api_calls, Calls}, RaceDataServer),
CG.
-
-new_race_data_server() ->
- spawn_link(fun() -> race_data_server_loop(#race_data_state{}) end).
-
-race_data_server_loop(State) ->
- receive
- {call, From, Ref, Query} ->
- Reply = race_data_server_handle_call(Query, State),
- From ! {Ref, Reply},
- race_data_server_loop(State);
- {cast, stop} ->
- ok;
- {cast, Message} ->
- NewState = race_data_server_handle_cast(Message, State),
- race_data_server_loop(NewState)
- end.
-
-race_data_server_call(Query, Server) ->
- Ref = make_ref(),
- Server ! {call, self(), Ref, Query},
- receive
- {Ref, Reply} -> Reply
- end.
-
-race_data_server_cast(Message, Server) ->
- Server ! {cast, Message},
- ok.
-
-race_data_server_handle_cast(race_code_new, State) ->
- State#race_data_state{race_code = dict:new()};
-race_data_server_handle_cast({Tag, Data}, State) ->
- case Tag of
- renew_race_info -> renew_race_info(Data, State);
- renew_race_code -> renew_race_code_handler(Data, State);
- renew_race_public_tables -> renew_race_public_tables_handler(Data, State);
- put_race_code -> State#race_data_state{race_code = Data};
- put_public_tables -> State#race_data_state{public_tables = Data};
- put_named_tables -> State#race_data_state{named_tables = Data};
- put_behaviour_api_calls -> State#race_data_state{beh_api_calls = Data}
- end.
-
-race_data_server_handle_call(Query,
- #race_data_state{race_code = RaceCode,
- public_tables = PublicTables,
- named_tables = NamedTables,
- beh_api_calls = BehApiCalls}
- = State) ->
- case Query of
- dup -> spawn_link(fun() -> race_data_server_loop(State) end);
- get_race_code -> RaceCode;
- get_public_tables -> PublicTables;
- get_named_tables -> NamedTables;
- get_behaviour_api_calls -> BehApiCalls
- end.
-
%%=============================================================================
%% Utilities for 'dot'
%%=============================================================================
diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl
index 9354b8007e..50ff5304d6 100644
--- a/lib/dialyzer/src/dialyzer_cl.erl
+++ b/lib/dialyzer/src/dialyzer_cl.erl
@@ -36,7 +36,7 @@
-include_lib("kernel/include/file.hrl"). % needed for #file_info{}
-record(cl_state,
- {backend_pid :: pid(),
+ {backend_pid :: pid() | 'undefined',
erlang_mode = false :: boolean(),
external_calls = [] :: [mfa()],
external_types = [] :: [mfa()],
diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl
index 978ecd3843..03cd9671af 100644
--- a/lib/dialyzer/src/dialyzer_codeserver.erl
+++ b/lib/dialyzer/src/dialyzer_codeserver.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -81,10 +81,10 @@
-record(codeserver, {next_core_label = 0 :: label(),
code :: dict_ets(),
- exported_types :: set_ets(), % set(mfa())
- records :: dict_ets(),
- contracts :: dict_ets(),
- callbacks :: dict_ets(),
+ exported_types :: set_ets() | 'undefined', % set(mfa())
+ records :: dict_ets() | 'undefined',
+ contracts :: dict_ets() | 'undefined',
+ callbacks :: dict_ets() | 'undefined',
fun_meta_info :: dict_ets(), % {mfa(), meta_info()}
exports :: 'clean' | set_ets(), % set(mfa())
temp_exported_types :: 'clean' | set_ets(), % set(mfa())
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 7251de8b10..e03e4d5bb4 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
@@ -126,13 +126,19 @@ butlast([H|T]) -> [H|butlast(T)].
constraints_to_string([]) ->
"";
-constraints_to_string([{type, _, constraint, [{atom, _, What}, Types]}]) ->
- atom_to_list(What) ++ "(" ++
- sequence([erl_types:t_form_to_string(T) || T <- Types], ",") ++ ")";
constraints_to_string([{type, _, constraint, [{atom, _, What}, Types]}|Rest]) ->
- atom_to_list(What) ++ "(" ++
- sequence([erl_types:t_form_to_string(T) || T <- Types], ",")
- ++ "), " ++ constraints_to_string(Rest).
+ S = constraint_to_string(What, Types),
+ case Rest of
+ [] -> S;
+ _ -> S ++ ", " ++ constraints_to_string(Rest)
+ end.
+
+constraint_to_string(is_subtype, [{var, _, Var}, T]) ->
+ atom_to_list(Var) ++ " :: " ++ erl_types:t_form_to_string(T);
+constraint_to_string(What, Types) ->
+ atom_to_list(What) ++ "("
+ ++ sequence([erl_types:t_form_to_string(T) || T <- Types], ",")
+ ++ ")".
sequence([], _Delimiter) -> "";
sequence([H], _Delimiter) -> H;
@@ -161,8 +167,7 @@ process_contract_remote_types(CodeServer) ->
dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict,
CodeServer).
--type opaques() :: [erl_types:erl_type()] | 'universe'.
--type opaques_fun() :: fun((module()) -> opaques()).
+-type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]).
-type fun_types() :: dict:dict(label(), erl_types:type_table()).
diff --git a/lib/dialyzer/src/dialyzer_coordinator.erl b/lib/dialyzer/src/dialyzer_coordinator.erl
index 612f379d32..87cbd25b30 100644
--- a/lib/dialyzer/src/dialyzer_coordinator.erl
+++ b/lib/dialyzer/src/dialyzer_coordinator.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -29,8 +29,8 @@
%%% Export for dialyzer main process
-export([parallel_job/4]).
-%%% Exports for all possible workers
--export([wait_activation/0, job_done/3]).
+%%% Export for all possible workers
+-export([job_done/3]).
%%% Exports for the typesig and dataflow analysis workers
-export([sccs_to_pids/2, request_activation/1]).
@@ -38,7 +38,7 @@
%%% Exports for the compilation workers
-export([get_next_label/2]).
--export_type([coordinator/0, mode/0, init_data/0, result/0]).
+-export_type([coordinator/0, mode/0, init_data/0, result/0, job/0]).
%%--------------------------------------------------------------------
@@ -46,16 +46,18 @@
-type regulator() :: pid().
-type scc_to_pid() :: ets:tid() | 'unused'.
--type coordinator() :: {collector(), regulator(), scc_to_pid()}. %%opaque
+-opaque coordinator() :: {collector(), regulator(), scc_to_pid()}.
-type timing() :: dialyzer_timing:timing_server().
-type scc() :: [mfa_or_funlbl()].
-type mode() :: 'typesig' | 'dataflow' | 'compile' | 'warnings'.
--type compile_jobs() :: [file:filename()].
--type typesig_jobs() :: [scc()].
--type dataflow_jobs() :: [module()].
--type warnings_jobs() :: [module()].
+-type compile_job() :: file:filename().
+-type typesig_job() :: scc().
+-type dataflow_job() :: module().
+-type warnings_job() :: module().
+
+-type job() :: compile_job() | typesig_job() | dataflow_job() | warnings_job().
-type compile_init_data() :: dialyzer_analysis_callgraph:compile_init_data().
-type typesig_init_data() :: dialyzer_succ_typings:typesig_init_data().
@@ -73,9 +75,9 @@
-type result() :: compile_result() | typesig_result() |
dataflow_result() | warnings_result().
--type job() :: scc() | module() | file:filename().
--type job_result() :: dialyzer_analysis_callgraph:one_file_result() |
- typesig_result() | dataflow_result() | warnings_result().
+-type job_result() :: dialyzer_analysis_callgraph:one_file_mid_error() |
+ dialyzer_analysis_callgraph:one_file_result_ok() |
+ typesig_result() | dataflow_result() | warnings_result().
-record(state, {mode :: mode(),
active = 0 :: integer(),
@@ -90,13 +92,13 @@
%%--------------------------------------------------------------------
--spec parallel_job('compile', compile_jobs(), compile_init_data(), timing()) ->
+-spec parallel_job('compile', [compile_job()], compile_init_data(), timing()) ->
{compile_result(), integer()};
- ('typesig', typesig_jobs(), typesig_init_data(), timing()) ->
+ ('typesig', [typesig_job()], typesig_init_data(), timing()) ->
typesig_result();
- ('dataflow', dataflow_jobs(), dataflow_init_data(),
+ ('dataflow', [dataflow_job()], dataflow_init_data(),
timing()) -> dataflow_result();
- ('warnings', warnings_jobs(), warnings_init_data(),
+ ('warnings', [warnings_job()], warnings_init_data(),
timing()) -> warnings_result().
parallel_job(Mode, Jobs, InitData, Timing) ->
@@ -118,7 +120,7 @@ spawn_jobs(Mode, Jobs, InitData, Timing) ->
Pid = dialyzer_worker:launch(Mode, Job, InitData, Coordinator),
case TypesigOrDataflow of
true -> true = ets:insert(SCCtoPID, {Job, Pid}), ok;
- false -> request_activation(Regulator, Pid)
+ false -> ok
end,
Count + 1
end,
@@ -217,10 +219,6 @@ request_activation({_Collector, Regulator, _SCCtoPID}) ->
Regulator ! {req, self()},
wait_activation().
-request_activation(Regulator, Pid) ->
- Regulator ! {req, Pid},
- ok.
-
spawn_regulator() ->
InitTickets = dialyzer_utils:parallelism(),
spawn_link(fun() -> regulator_loop(InitTickets, queue:new()) end).
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index cabc5e9e0d..6e49043551 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -99,19 +99,29 @@
-define(BITS, 128).
--record(state, {callgraph :: dialyzer_callgraph:callgraph(),
- codeserver :: dialyzer_codeserver:codeserver(),
- envs :: env_tab(),
- fun_tab :: fun_tab(),
- fun_homes :: dict:dict(label(), mfa()),
- plt :: dialyzer_plt:plt(),
- opaques :: [type()],
+%% Types with comment 'race' are due to dialyzer_races.erl.
+-record(state, {callgraph :: dialyzer_callgraph:callgraph()
+ | 'undefined', % race
+ codeserver :: dialyzer_codeserver:codeserver()
+ | 'undefined', % race
+ envs :: env_tab()
+ | 'undefined', % race
+ fun_tab :: fun_tab()
+ | 'undefined', % race
+ fun_homes :: dict:dict(label(), mfa())
+ | 'undefined', % race
+ plt :: dialyzer_plt:plt()
+ | 'undefined', % race
+ opaques :: [type()]
+ | 'undefined', % race
races = dialyzer_races:new() :: dialyzer_races:races(),
records = dict:new() :: types(),
- tree_map :: dict:dict(label(), cerl:cerl()),
+ tree_map :: dict:dict(label(), cerl:cerl())
+ | 'undefined', % race
warning_mode = false :: boolean(),
warnings = [] :: [raw_warning()],
- work :: {[_], [_], sets:set()},
+ work :: {[_], [_], sets:set()}
+ | 'undefined', % race
module :: module(),
curr_fun :: curr_fun()
}).
diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl
index ff54a91ce1..9f344d87ff 100644
--- a/lib/dialyzer/src/dialyzer_gui_wx.erl
+++ b/lib/dialyzer/src/dialyzer_gui_wx.erl
@@ -2,7 +2,7 @@
%%------------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
@@ -52,7 +52,6 @@
add_dir :: wx:wx_object(),
add_rec :: wx:wx_object(),
chosen_box :: wx:wx_object(),
- analysis_pid :: pid(),
del_file :: wx:wx_object(),
doc_plt :: dialyzer_plt:plt(),
clear_chosen :: wx:wx_object(),
@@ -72,11 +71,11 @@
stop :: wx:wx_object(),
frame :: wx:wx_object(),
warnings_box :: wx:wx_object(),
- explanation_box :: wx:wx_object(),
+ explanation_box :: wx:wx_object() | 'undefined',
wantedWarnings :: list(),
rawWarnings :: list(),
- backend_pid :: pid(),
- expl_pid :: pid()}).
+ backend_pid :: pid() | 'undefined',
+ expl_pid :: pid() | 'undefined'}).
%%------------------------------------------------------------------------
diff --git a/lib/dialyzer/src/dialyzer_race_data_server.erl b/lib/dialyzer/src/dialyzer_race_data_server.erl
new file mode 100644
index 0000000000..3600491809
--- /dev/null
+++ b/lib/dialyzer/src/dialyzer_race_data_server.erl
@@ -0,0 +1,134 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-----------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-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%
+%%
+
+%%%-------------------------------------------------------------------
+%%% File : dialyzer_race_data_server.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 18 Sep 2015 by Luca Favatella <[email protected]>
+%%%-------------------------------------------------------------------
+-module(dialyzer_race_data_server).
+
+-export([new/0,
+ duplicate/1,
+ stop/1,
+ call/2,
+ cast/2]).
+
+-include("dialyzer.hrl").
+
+%%----------------------------------------------------------------------
+
+-record(state, {race_code = dict:new() :: dict:dict(),
+ public_tables = [] :: [label()],
+ named_tables = [] :: [string()],
+ beh_api_calls = [] :: [{mfa(), mfa()}]}).
+
+%%----------------------------------------------------------------------
+
+-spec new() -> pid().
+
+new() ->
+ spawn_link(fun() -> loop(#state{}) end).
+
+-spec duplicate(pid()) -> pid().
+
+duplicate(Server) ->
+ call(dup, Server).
+
+-spec stop(pid()) -> ok.
+
+stop(Server) ->
+ cast(stop, Server).
+
+-spec call(atom(), pid()) -> term().
+
+call(Query, Server) ->
+ Ref = make_ref(),
+ Server ! {call, self(), Ref, Query},
+ receive
+ {Ref, Reply} -> Reply
+ end.
+
+-spec cast(atom() | {atom(), term()}, pid()) -> ok.
+
+cast(Message, Server) ->
+ Server ! {cast, Message},
+ ok.
+
+%%----------------------------------------------------------------------
+
+loop(State) ->
+ receive
+ {call, From, Ref, Query} ->
+ Reply = handle_call(Query, State),
+ From ! {Ref, Reply},
+ loop(State);
+ {cast, stop} ->
+ ok;
+ {cast, Message} ->
+ NewState = handle_cast(Message, State),
+ loop(NewState)
+ end.
+
+handle_cast(race_code_new, State) ->
+ State#state{race_code = dict:new()};
+handle_cast({Tag, Data}, State) ->
+ case Tag of
+ renew_race_info -> renew_race_info_handler(Data, State);
+ renew_race_code -> renew_race_code_handler(Data, State);
+ renew_race_public_tables -> renew_race_public_tables_handler(Data, State);
+ put_race_code -> State#state{race_code = Data};
+ put_public_tables -> State#state{public_tables = Data};
+ put_named_tables -> State#state{named_tables = Data};
+ put_behaviour_api_calls -> State#state{beh_api_calls = Data}
+ end.
+
+handle_call(Query,
+ #state{race_code = RaceCode,
+ public_tables = PublicTables,
+ named_tables = NamedTables,
+ beh_api_calls = BehApiCalls}
+ = State) ->
+ case Query of
+ dup -> spawn_link(fun() -> loop(State) end);
+ get_race_code -> RaceCode;
+ get_public_tables -> PublicTables;
+ get_named_tables -> NamedTables;
+ get_behaviour_api_calls -> BehApiCalls
+ end.
+
+%%----------------------------------------------------------------------
+
+renew_race_info_handler({RaceCode, PublicTables, NamedTables},
+ #state{} = State) ->
+ State#state{race_code = RaceCode,
+ public_tables = PublicTables,
+ named_tables = NamedTables}.
+
+renew_race_code_handler({Fun, FunArgs, Code},
+ #state{race_code = RaceCode} = State) ->
+ State#state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}.
+
+renew_race_public_tables_handler(VarLabel,
+ #state{public_tables = PT} = State) ->
+ State#state{public_tables = ordsets:add_element(VarLabel, PT)}.
diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl
index 39de071bde..bb43d1dcb8 100644
--- a/lib/dialyzer/src/dialyzer_races.erl
+++ b/lib/dialyzer/src/dialyzer_races.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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.
@@ -92,27 +92,28 @@
-type race_warn_tag() :: ?WARN_WHEREIS_REGISTER | ?WARN_WHEREIS_UNREGISTER
| ?WARN_ETS_LOOKUP_INSERT | ?WARN_MNESIA_DIRTY_READ_WRITE.
--record(beg_clause, {arg :: var_to_map1(),
- pats :: var_to_map1(),
- guard :: cerl:cerl()}).
--record(end_clause, {arg :: var_to_map1(),
- pats :: var_to_map1(),
- guard :: cerl:cerl()}).
+-record(beg_clause, {arg :: var_to_map1() | 'undefined',
+ pats :: var_to_map1() | 'undefined',
+ guard :: cerl:cerl() | 'undefined'}).
+-record(end_clause, {arg :: var_to_map1() | 'undefined',
+ pats :: var_to_map1() | 'undefined',
+ guard :: cerl:cerl() | 'undefined'}).
-record(end_case, {clauses :: [#end_clause{}]}).
--record(curr_fun, {status :: 'in' | 'out',
- mfa :: dialyzer_callgraph:mfa_or_funlbl(),
- label :: label(),
- def_vars :: [core_vars()],
- arg_types :: [erl_types:erl_type()],
- call_vars :: [core_vars()],
- var_map :: dict:dict()}).
+-record(curr_fun, {status :: 'in' | 'out' | 'undefined',
+ mfa :: dialyzer_callgraph:mfa_or_funlbl()
+ | 'undefined',
+ label :: label() | 'undefined',
+ def_vars :: [core_vars()] | 'undefined',
+ arg_types :: [erl_types:erl_type()] | 'undefined',
+ call_vars :: [core_vars()] | 'undefined',
+ var_map :: dict:dict() | 'undefined'}).
-record(dep_call, {call_name :: dep_calls(),
- args :: args(),
+ args :: args() | 'undefined',
arg_types :: [erl_types:erl_type()],
vars :: [core_vars()],
state :: dialyzer_dataflow:state(),
file_line :: file_line(),
- var_map :: dict:dict()}).
+ var_map :: dict:dict() | 'undefined'}).
-record(fun_call, {caller :: dialyzer_callgraph:mfa_or_funlbl(),
callee :: dialyzer_callgraph:mfa_or_funlbl(),
arg_types :: [erl_types:erl_type()],
@@ -121,7 +122,7 @@
arg :: var_to_map1()}).
-record(warn_call, {call_name :: warn_calls(),
args :: args(),
- var_map :: dict:dict()}).
+ var_map :: dict:dict() | 'undefined'}).
-type case_tags() :: 'beg_case' | #beg_clause{} | #end_clause{} | #end_case{}.
-type code() :: [#dep_call{} | #fun_call{} | #warn_call{} |
@@ -139,8 +140,9 @@
fun_mfa :: dialyzer_callgraph:mfa_or_funlbl(),
fun_label :: label()}).
--record(races, {curr_fun :: dialyzer_callgraph:mfa_or_funlbl(),
- curr_fun_label :: label(),
+-record(races, {curr_fun :: dialyzer_callgraph:mfa_or_funlbl()
+ | 'undefined',
+ curr_fun_label :: label() | 'undefined',
curr_fun_args = 'empty' :: core_args(),
new_table = 'no_t' :: table(),
race_list = [] :: code(),
diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl
index 18f02e6742..987da3aecf 100644
--- a/lib/dialyzer/src/dialyzer_succ_typings.erl
+++ b/lib/dialyzer/src/dialyzer_succ_typings.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -134,7 +134,6 @@ get_refined_success_typings(SCCs, #st{callgraph = Callgraph,
end
end.
--type doc_plt() :: 'undefined' | dialyzer_plt:plt().
-spec get_warnings(dialyzer_callgraph:callgraph(), dialyzer_plt:plt(),
doc_plt(), dialyzer_codeserver:codeserver(),
dialyzer_timing:timing_server(), [solver()], pid()) ->
diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl
index 0b8b244cc9..5f0881bbcd 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -68,7 +68,7 @@
-type type_var() :: erl_types:erl_type(). %% actually: {'c','var',_,_}
-record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: [dep()],
- origin :: integer()}).
+ origin :: integer() | 'undefined'}).
-type constr_op() :: 'eq' | 'sub'.
-type fvar_or_type() :: #fun_var{} | erl_types:erl_type().
@@ -83,9 +83,9 @@
-record(constraint_list, {type :: 'conj' | 'disj',
list :: [constr()],
deps :: [dep()],
- masks :: [{dep(),[non_neg_integer()]}] |
- {'d',dict:dict(dep(), [non_neg_integer()])},
- id :: {'list', dep()}}).
+ masks = [] :: [{dep(),[non_neg_integer()]}] |
+ {'d',dict:dict(dep(), [non_neg_integer()])},
+ id :: {'list', dep()} | 'undefined'}).
-type constraint_list() :: #constraint_list{}.
@@ -104,7 +104,8 @@
-type dict_or_ets() :: {'d', prop_types()} | {'e', ets:tid()}.
--record(state, {callgraph :: dialyzer_callgraph:callgraph(),
+-record(state, {callgraph :: dialyzer_callgraph:callgraph()
+ | 'undefined',
cs = [] :: [constr()],
cmap = {'d', dict:new()} :: dict_or_ets(),
fun_map = [] :: typesig_funmap(),
@@ -116,7 +117,8 @@
cerl:c_fun()),
next_label = 0 :: label(),
self_rec :: 'false' | erl_types:erl_type(),
- plt :: dialyzer_plt:plt(),
+ plt :: dialyzer_plt:plt()
+ | 'undefined',
prop_types = {'d', dict:new()} :: dict_or_ets(),
records = dict:new() :: types(),
scc = [] :: [type_var()],
@@ -1746,7 +1748,10 @@ minimize_state(#state{
fun_arities = FunArities,
self_rec = SelfRec,
prop_types = {e, ETSPropTypes},
- solvers = Solvers
+ solvers = Solvers,
+ callgraph = undefined,
+ plt = undefined,
+ mfas = []
}.
dispose_state(#state{cmap = {e, ETSCMap},
@@ -2884,8 +2889,7 @@ mk_constraint(Lhs, Op, Rhs) ->
case t_is_any(Lhs) orelse constraint_opnd_is_any(Rhs) of
false ->
Deps = find_constraint_deps([Lhs, Rhs]),
- C0 = mk_constraint_1(Lhs, Op, Rhs),
- C = C0#constraint{deps = Deps},
+ C = mk_constraint_1(Lhs, Op, Rhs, Deps),
case Deps =:= [] of
true ->
%% This constraint is constant. Solve it immediately.
@@ -2903,8 +2907,7 @@ mk_constraint(Lhs, Op, Rhs) ->
end.
mk_constraint_any(Op) ->
- C = mk_constraint_1(t_any(), Op, t_any()),
- C#constraint{deps = []}.
+ mk_constraint_1(t_any(), Op, t_any(), []).
%% the following function is used so that we do not call
%% erl_types:t_is_any/1 with a term other than an erl_type()
@@ -2952,12 +2955,12 @@ find_constraint_deps([Type|Tail], Acc) ->
find_constraint_deps([], Acc) ->
lists:flatten(Acc).
-mk_constraint_1(Lhs, eq, Rhs) when Lhs < Rhs ->
- #constraint{lhs = Lhs, op = eq, rhs = Rhs};
-mk_constraint_1(Lhs, eq, Rhs) ->
- #constraint{lhs = Rhs, op = eq, rhs = Lhs};
-mk_constraint_1(Lhs, Op, Rhs) ->
- #constraint{lhs = Lhs, op = Op, rhs = Rhs}.
+mk_constraint_1(Lhs, eq, Rhs, Deps) when Lhs < Rhs ->
+ #constraint{lhs = Lhs, op = eq, rhs = Rhs, deps = Deps};
+mk_constraint_1(Lhs, eq, Rhs, Deps) ->
+ #constraint{lhs = Rhs, op = eq, rhs = Lhs, deps = Deps};
+mk_constraint_1(Lhs, Op, Rhs, Deps) ->
+ #constraint{lhs = Lhs, op = Op, rhs = Rhs, deps = Deps}.
mk_constraints([Lhs|LhsTail], Op, [Rhs|RhsTail]) ->
[mk_constraint(Lhs, Op, Rhs) |
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index 7fe982a992..5fc1c0e691 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -83,7 +83,7 @@ print_types1([{record, _Name} = Key|T], RecDict) ->
%% ----------------------------------------------------------------------------
--type abstract_code() :: [tuple()]. %% XXX: import from somewhere
+-type abstract_code() :: [erl_parse:abstract_form()].
-type comp_options() :: [compile:option()].
-type mod_or_fname() :: module() | file:filename().
-type fa() :: {atom(), arity()}.
@@ -297,8 +297,8 @@ get_record_fields([], _RecDict, Acc) ->
%% The field types are cached. Used during analysis when handling records.
process_record_remote_types(CServer) ->
TempRecords = dialyzer_codeserver:get_temp_records(CServer),
- TempExpTypes = dialyzer_codeserver:get_temp_exported_types(CServer),
- TempRecords1 = process_opaque_types0(TempRecords, TempExpTypes),
+ ExpTypes = dialyzer_codeserver:get_exported_types(CServer),
+ TempRecords1 = process_opaque_types0(TempRecords, ExpTypes),
ModuleFun =
fun(Module, Record) ->
RecordFun =
@@ -310,7 +310,7 @@ process_record_remote_types(CServer) ->
Site = {record, {Module, Name, Arity}},
[{FieldName, Field,
erl_types:t_from_form(Field,
- TempExpTypes,
+ ExpTypes,
Site,
TempRecords1)}
|| {FieldName, Field, _} <- Fields]
@@ -323,9 +323,8 @@ process_record_remote_types(CServer) ->
dict:map(RecordFun, Record)
end,
NewRecords = dict:map(ModuleFun, TempRecords1),
- ok = check_record_fields(NewRecords, TempExpTypes),
- CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer),
- dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1).
+ ok = check_record_fields(NewRecords, ExpTypes),
+ dialyzer_codeserver:finalize_records(NewRecords, CServer).
%% erl_types:t_from_form() substitutes the declaration of opaque types
%% for the expanded type in some cases. To make sure the initial type,
diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl
index 4be93c75bf..b9ab27c11d 100644
--- a/lib/dialyzer/src/dialyzer_worker.erl
+++ b/lib/dialyzer/src/dialyzer_worker.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -21,20 +21,20 @@
-module(dialyzer_worker).
--export([launch/4, sequential/4]).
+-export([launch/4]).
-export_type([worker/0]).
--type worker() :: pid(). %%opaque
+-opaque worker() :: pid().
-type mode() :: dialyzer_coordinator:mode().
-type coordinator() :: dialyzer_coordinator:coordinator().
-type init_data() :: dialyzer_coordinator:init_data().
--type result() :: dialyzer_coordinator:result().
+-type job() :: dialyzer_coordinator:job().
-record(state, {
mode :: mode(),
- job :: mfa_or_funlbl() | file:filename(),
+ job :: job(),
coordinator :: coordinator(),
init_data :: init_data(),
depends_on = [] :: list()
@@ -52,23 +52,28 @@
%%--------------------------------------------------------------------
--spec launch(mode(), [mfa_or_funlbl()], init_data(), coordinator()) -> worker().
+-spec launch(mode(), job(), init_data(), coordinator()) -> worker().
launch(Mode, Job, InitData, Coordinator) ->
State = #state{mode = Mode,
job = Job,
init_data = InitData,
coordinator = Coordinator},
- InitState =
- case Mode of
- X when X =:= 'typesig'; X =:= 'dataflow' -> initializing;
- X when X =:= 'compile'; X =:= 'warnings' -> running
- end,
- spawn_link(fun() -> loop(InitState, State) end).
+ spawn_link(fun() -> init(State) end).
%%--------------------------------------------------------------------
-loop(updating, State) ->
+init(#state{job = SCC, mode = Mode, init_data = InitData} = State) when
+ Mode =:= 'typesig'; Mode =:= 'dataflow' ->
+ DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData),
+ ?debug("Deps ~p: ~p\n",[SCC, DependsOn]),
+ loop(updating, State#state{depends_on = DependsOn});
+init(#state{mode = Mode} = State) when
+ Mode =:= 'compile'; Mode =:= 'warnings' ->
+ loop(running, State).
+
+loop(updating, #state{mode = Mode} = State) when
+ Mode =:= 'typesig'; Mode =:= 'dataflow' ->
?debug("Update: ~p\n",[State#state.job]),
NextStatus =
case waits_more_success_typings(State) of
@@ -76,16 +81,13 @@ loop(updating, State) ->
false -> running
end,
loop(NextStatus, State);
-loop(initializing, #state{job = SCC, init_data = InitData} = State) ->
- DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData),
- ?debug("Deps ~p: ~p\n",[State#state.job, DependsOn]),
- loop(updating, State#state{depends_on = DependsOn});
-loop(waiting, State) ->
+loop(waiting, #state{mode = Mode} = State) when
+ Mode =:= 'typesig'; Mode =:= 'dataflow' ->
?debug("Wait: ~p\n",[State#state.job]),
NewState = wait_for_success_typings(State),
loop(updating, NewState);
loop(running, #state{mode = 'compile'} = State) ->
- dialyzer_coordinator:wait_activation(),
+ dialyzer_coordinator:request_activation(State#state.coordinator),
?debug("Compile: ~s\n",[State#state.job]),
Result =
case start_compilation(State) of
@@ -97,7 +99,7 @@ loop(running, #state{mode = 'compile'} = State) ->
end,
report_to_coordinator(Result, State);
loop(running, #state{mode = 'warnings'} = State) ->
- dialyzer_coordinator:wait_activation(),
+ dialyzer_coordinator:request_activation(State#state.coordinator),
?debug("Warning: ~s\n",[State#state.job]),
Result = collect_warnings(State),
report_to_coordinator(Result, State);
@@ -169,22 +171,3 @@ continue_compilation(Label, Data) ->
collect_warnings(#state{job = Job, init_data = InitData}) ->
dialyzer_succ_typings:collect_warnings(Job, InitData).
-
-%%------------------------------------------------------------------------------
-
--type extra() :: label() | 'unused'.
-
--spec sequential(mode(), [mfa_or_funlbl()], init_data(), extra()) -> result().
-
-sequential('compile', Job, InitData, Extra) ->
- case dialyzer_analysis_callgraph:start_compilation(Job, InitData) of
- {ok, EstimatedSize, Data} ->
- {EstimatedSize, continue_compilation(Extra, Data)};
- {error, _Reason} = Error -> {0, Error}
- end;
-sequential('typesig', Job, InitData, _Extra) ->
- dialyzer_succ_typings:find_succ_types_for_scc(Job, InitData);
-sequential('dataflow', Job, InitData, _Extra) ->
- dialyzer_succ_typings:refine_one_module(Job, InitData);
-sequential('warnings', Job, InitData, _Extra) ->
- dialyzer_succ_typings:collect_warnings(Job, InitData).
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs
index 33d135048e..38999e8919 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs
@@ -1,5 +1,5 @@
-my_callbacks_wrong.erl:26: The return type #state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()} in the specification of callback_init/1 is not a subtype of {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour
-my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 (#state{parent::'undefined' | pid(),status::'init',subscribe::[],counter::1}) has nothing in common with {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour
-my_callbacks_wrong.erl:30: The return type {'reply',#state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of my_behaviour behaviour
+my_callbacks_wrong.erl:26: The return type #state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()} in the specification of callback_init/1 is not a subtype of {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour
+my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 (#state{parent::pid(),status::'init',subscribe::[],counter::1}) has nothing in common with {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour
+my_callbacks_wrong.erl:30: The return type {'reply',#state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of my_behaviour behaviour
my_callbacks_wrong.erl:39: The specified type for the 2nd argument of callback_call/3 (atom()) is not a supertype of pid(), which is expected type for this argument in the callback of the my_behaviour behaviour
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return
index 4103a2d8b4..89eb295604 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return
@@ -1,2 +1,2 @@
-supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom() | tuple(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom() | tuple()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour
+supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour
diff --git a/lib/dialyzer/test/dialyzer_SUITE.erl b/lib/dialyzer/test/dialyzer_SUITE.erl
index 80f4508ec6..8a2324a7c2 100644
--- a/lib/dialyzer/test/dialyzer_SUITE.erl
+++ b/lib/dialyzer/test/dialyzer_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(dialyzer_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash
index 69bdc00257..d63389f79c 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/crash
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash
@@ -1,6 +1,6 @@
-crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::'undefined' | crash_1:target()
-crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),maybe_improper_list())
-crash_1.erl:50: The pattern <_Branch, []> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()>
-crash_1.erl:52: The pattern <Branch, [H = {'target', _, _} | _T]> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()>
-crash_1.erl:54: The pattern <Branch, [{'target', _, _} | T]> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()>
+crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::crash_1:target()
+crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::crash_1:target()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),maybe_improper_list())
+crash_1.erl:50: The pattern <_Branch, []> can never match the type <maybe_improper_list(),crash_1:target()>
+crash_1.erl:52: The pattern <Branch, [H = {'target', _, _} | _T]> can never match the type <maybe_improper_list(),crash_1:target()>
+crash_1.erl:54: The pattern <Branch, [{'target', _, _} | T]> can never match the type <maybe_improper_list(),crash_1:target()>
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple
index 1a7a139d6e..391c37664e 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/simple
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple
@@ -18,7 +18,7 @@ rec_api.erl:104: Matching of pattern {'r2', 10} tagged with a record name violat
rec_api.erl:113: The attempt to match a term of type #r3{f1::queue:queue(_)} against the pattern {'r3', 'a'} breaks the opaqueness of queue:queue(_)
rec_api.erl:118: Record construction #r3{f1::10} violates the declared type of field f1::queue:queue(_)
rec_api.erl:123: The attempt to match a term of type #r3{f1::10} against the pattern {'r3', 10} breaks the opaqueness of queue:queue(_)
-rec_api.erl:24: Record construction #r1{f1::10} violates the declared type of field f1::'undefined' | rec_api:a()
+rec_api.erl:24: Record construction #r1{f1::10} violates the declared type of field f1::rec_api:a()
rec_api.erl:29: Matching of pattern {'r1', 10} tagged with a record name violates the declared type of #r1{f1::10}
rec_api.erl:33: The attempt to match a term of type rec_adt:r1() against the pattern {'r1', 'a'} breaks the opaqueness of the term
rec_api.erl:35: Invalid type specification for function rec_api:adt_t1/1. The success typing is (#r1{f1::'a'}) -> #r1{f1::'a'}
@@ -70,8 +70,8 @@ simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opaqueness
simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opaqueness of the term A :: simple1_adt:a()
simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i()
simple1_api.erl:503: The call 'foo':A(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i()
-simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() | tuple() not simple1_api:i()
-simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() | tuple() not simple1_adt:i()
+simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i()
+simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i()
simple1_api.erl:519: Guard test A::simple1_adt:d2() == B::simple1_adt:d1() contains opaque terms as 1st and 2nd arguments
simple1_api.erl:534: Guard test A::simple1_adt:d1() >= 3 contains an opaque term as 1st argument
simple1_api.erl:536: Guard test A::simple1_adt:d1() == 3 contains an opaque term as 1st argument
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl b/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl
index b6cab5e24b..1677b4efb8 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl
@@ -781,7 +781,8 @@ add_mod_info({attribute,_Line,record,{RecName,Fields}},
true ->
ModInfo;
false ->
- TypedRecord = {attribute,0,type,{{record,RecName},Fields,[]}},
+ A = erl_anno:new(0),
+ TypedRecord = {attribute,A,type,{{record,RecName},Fields,[]}},
add_mod_info(TypedRecord, ModInfo)
end;
add_mod_info({attribute,_Line,Kind,{Name,TypeForm,VarForms}},
diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia
index b73943422a..bf67447ee7 100644
--- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia
+++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia
@@ -6,7 +6,7 @@ mnesia_bup.erl:111: The created fun has no local return
mnesia_bup.erl:574: Function fallback_receiver/2 has no local return
mnesia_bup.erl:967: Function uninstall_fallback_master/2 has no local return
mnesia_checkpoint.erl:1014: The variable Error can never match since previous clauses completely covered the type {'ok',#checkpoint_args{nodes::[any()],retainers::[any(),...]}}
-mnesia_checkpoint.erl:894: The call sys:handle_system_msg(Msg::any(),From::any(),'no_parent','mnesia_checkpoint',[],Cp::#checkpoint_args{}) breaks the contract (Msg,From,Parent,Module,Debug,Misc) -> no_return() when is_subtype(Msg,term()), is_subtype(From,{pid(),Tag::_}), is_subtype(Parent,pid()), is_subtype(Module,module()), is_subtype(Debug,[dbg_opt()]), is_subtype(Misc,term())
+mnesia_checkpoint.erl:894: The call sys:handle_system_msg(Msg::any(),From::any(),'no_parent','mnesia_checkpoint',[],Cp::#checkpoint_args{}) breaks the contract (Msg,From,Parent,Module,Debug,Misc) -> no_return() when Msg :: term(), From :: {pid(),Tag::_}, Parent :: pid(), Module :: module(), Debug :: [dbg_opt()], Misc :: term()
mnesia_controller.erl:1666: The variable Tab can never match since previous clauses completely covered the type [any()]
mnesia_controller.erl:1679: The pattern {'stop', Reason, Reply, State2} can never match the type {'noreply',_} | {'reply',_,_} | {'stop','shutdown',#state{}}
mnesia_controller.erl:1685: The pattern {'noreply', State2, _Timeout} can never match the type {'reply',_,_}
@@ -35,6 +35,6 @@ mnesia_schema.erl:1258: Guard test FromS::'disc_copies' | 'disc_only_copies' | '
mnesia_schema.erl:1639: The pattern {'false', 'mandatory'} can never match the type {'false','optional'}
mnesia_schema.erl:2434: The variable Reason can never match since previous clauses completely covered the type {'error',_} | {'ok',_}
mnesia_schema.erl:451: Guard test UseDirAnyway::'false' == 'true' can never succeed
-mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{integer(),atom() | tuple(),_}} | {'ok',_}
+mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer(),atom(),_}} | {'ok',_}
mnesia_tm.erl:1522: Function commit_participant/5 has no local return
mnesia_tm.erl:2169: Function system_terminate/4 has no local return
diff --git a/lib/dialyzer/test/small_SUITE_data/results/app_call b/lib/dialyzer/test/small_SUITE_data/results/app_call
index cc1a63f944..1af649815a 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/app_call
+++ b/lib/dialyzer/test/small_SUITE_data/results/app_call
@@ -1,3 +1,3 @@
-app_call.erl:6: The call M:'foo'() requires that M is of type atom() | tuple() not 42
+app_call.erl:6: The call M:'foo'() requires that M is of type atom() not 42
app_call.erl:9: The call 'mod':F() requires that F is of type atom() not {'gazonk',[]}
diff --git a/lib/dialyzer/test/small_SUITE_data/results/bif1 b/lib/dialyzer/test/small_SUITE_data/results/bif1
new file mode 100644
index 0000000000..289b6f821f
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/bif1
@@ -0,0 +1,3 @@
+
+bif1.erl:13: Function string_chars/0 has no local return
+bif1.erl:16: The call string:chars(S::65,10,L2::bif1_adt:s()) contains an opaque term as 3rd argument when terms of different types are expected in these positions
diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes
index a9fbfb6068..d2a3ebb766 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes
+++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes
@@ -1,15 +1,15 @@
-contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg({'a','b'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A})
-contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg({'b','a'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A})
-contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A})
-contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2({'a','b'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab())
-contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2({'b','a'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab())
-contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab())
-contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab())
-contracts_with_subtypes.erl:139: The call contracts_with_subtypes:rec2({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab())
-contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab())
-contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2({'a',{'b',{'a',{'b','a'}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab())
-contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2({'b',{'a',{'b',{'a','b'}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab())
+contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg({'a','b'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A}
+contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg({'b','a'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A}
+contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A}
+contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2({'a','b'}) breaks the contract (Arg) -> 'ok' when Arg :: ab()
+contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2({'b','a'}) breaks the contract (Arg) -> 'ok' when Arg :: ab()
+contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab()
+contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab()
+contracts_with_subtypes.erl:139: The call contracts_with_subtypes:rec2({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab()
+contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab()
+contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2({'a',{'b',{'a',{'b','a'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab()
+contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2({'b',{'a',{'b',{'a','b'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab()
contracts_with_subtypes.erl:175: The pattern 1 can never match the type string()
contracts_with_subtypes.erl:178: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()}
contracts_with_subtypes.erl:180: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()}
@@ -24,13 +24,13 @@ contracts_with_subtypes.erl:23: Invalid type specification for function contract
contracts_with_subtypes.erl:240: The pattern {'ok', 42} can never match the type {'ok',_,string()}
contracts_with_subtypes.erl:241: The pattern 42 can never match the type {'ok',_,string()}
contracts_with_subtypes.erl:267: Function flat_ets_new_t/0 has no local return
-contracts_with_subtypes.erl:268: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed')
+contracts_with_subtypes.erl:268: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when Name :: atom(), Options :: [Option], Option :: 'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed'
contracts_with_subtypes.erl:294: Function factored_ets_new_t/0 has no local return
-contracts_with_subtypes.erl:295: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks), is_subtype(Type,type()), is_subtype(Access,access()), is_subtype(Tweaks,{'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed'), is_subtype(Pos,pos_integer()), is_subtype(HeirData,term())
-contracts_with_subtypes.erl:77: The call contracts_with_subtypes:foo1(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,atom()), is_subtype(Res,atom())
-contracts_with_subtypes.erl:78: The call contracts_with_subtypes:foo2(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,Arg2), is_subtype(Arg2,atom()), is_subtype(Res,atom())
-contracts_with_subtypes.erl:79: The call contracts_with_subtypes:foo3(5) breaks the contract (Arg1) -> Res when is_subtype(Arg2,atom()), is_subtype(Arg1,Arg2), is_subtype(Res,atom())
+contracts_with_subtypes.erl:295: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when Name :: atom(), Options :: [Option], Option :: Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks, Type :: type(), Access :: access(), Tweaks :: {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed', Pos :: pos_integer(), HeirData :: term()
+contracts_with_subtypes.erl:77: The call contracts_with_subtypes:foo1(5) breaks the contract (Arg1) -> Res when Arg1 :: atom(), Res :: atom()
+contracts_with_subtypes.erl:78: The call contracts_with_subtypes:foo2(5) breaks the contract (Arg1) -> Res when Arg1 :: Arg2, Arg2 :: atom(), Res :: atom()
+contracts_with_subtypes.erl:79: The call contracts_with_subtypes:foo3(5) breaks the contract (Arg1) -> Res when Arg2 :: atom(), Arg1 :: Arg2, Res :: atom()
contracts_with_subtypes.erl:7: Invalid type specification for function contracts_with_subtypes:extract/0. The success typing is () -> 'something'
-contracts_with_subtypes.erl:80: The call contracts_with_subtypes:foo4(5) breaks the contract (Type) -> Type when is_subtype(Type,atom())
+contracts_with_subtypes.erl:80: The call contracts_with_subtypes:foo4(5) breaks the contract (Type) -> Type when Type :: atom()
contracts_with_subtypes.erl:81: The call contracts_with_subtypes:foo5(5) breaks the contract (Type::atom()) -> Type::atom()
-contracts_with_subtypes.erl:82: The call contracts_with_subtypes:foo6(5) breaks the contract (Type) -> Type when is_subtype(Type,atom())
+contracts_with_subtypes.erl:82: The call contracts_with_subtypes:foo6(5) breaks the contract (Type) -> Type when Type :: atom()
diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2
index 9f5433a13d..1a8aeb13d0 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2
+++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2
@@ -1,3 +1,3 @@
contracts_with_subtypes2.erl:18: Function t/0 has no local return
-contracts_with_subtypes2.erl:19: The call contracts_with_subtypes2:t({'a',{'b',{'c',{'d',{'e',{'g',3}}}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A}), is_subtype(A,{'b',B}), is_subtype(B,{'c',C}), is_subtype(C,{'d',D}), is_subtype(D,{'e',E}), is_subtype(E,{'f',_})
+contracts_with_subtypes2.erl:19: The call contracts_with_subtypes2:t({'a',{'b',{'c',{'d',{'e',{'g',3}}}}}}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A}, A :: {'b',B}, B :: {'c',C}, C :: {'d',D}, D :: {'e',E}, E :: {'f',_}
diff --git a/lib/dialyzer/test/small_SUITE_data/results/literals b/lib/dialyzer/test/small_SUITE_data/results/literals
index 03e161ca71..222d2c0cdb 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/literals
+++ b/lib/dialyzer/test/small_SUITE_data/results/literals
@@ -1,14 +1,14 @@
literals.erl:11: Function t1/0 has no local return
-literals.erl:12: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined'
+literals.erl:12: Record construction #r{id::'a'} violates the declared type of field id::'integer'
literals.erl:14: Function t2/0 has no local return
-literals.erl:15: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined'
+literals.erl:15: Record construction #r{id::'a'} violates the declared type of field id::'integer'
literals.erl:17: Function t3/0 has no local return
-literals.erl:18: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined'
-literals.erl:21: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined'
+literals.erl:18: Record construction #r{id::'a'} violates the declared type of field id::'integer'
+literals.erl:21: Record construction #r{id::'a'} violates the declared type of field id::'integer'
literals.erl:23: Function m1/1 has no local return
-literals.erl:23: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer' | 'undefined'}
+literals.erl:23: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'}
literals.erl:26: Function m2/1 has no local return
-literals.erl:26: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer' | 'undefined'}
+literals.erl:26: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'}
literals.erl:29: Function m3/1 has no local return
literals.erl:29: The pattern {{'r', 'a'}} can never match the type any()
diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps1 b/lib/dialyzer/test/small_SUITE_data/results/maps1
index 5a78d66a92..e88c91f21f 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/maps1
+++ b/lib/dialyzer/test/small_SUITE_data/results/maps1
@@ -1,4 +1,4 @@
maps1.erl:43: Function t3/0 has no local return
maps1.erl:44: The call maps1:foo(~{'greger'=>3, ~{'arne'=>'anka'}~=>45}~,1) will never return since it differs in the 2nd argument from the success typing arguments: (#{},'b')
-maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() | tuple() not #{}
+maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() not #{}
diff --git a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring
index 0ad6eee766..e148e5cf22 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring
+++ b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring
@@ -1,3 +1,3 @@
pretty_bitstring.erl:7: Function t/0 has no local return
-pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when is_subtype(Subject,binary()), is_subtype(N,non_neg_integer())
+pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when Subject :: binary(), N :: non_neg_integer()
diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs b/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs
index f00c4b10ff..c971935bbf 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs
+++ b/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs
@@ -1,3 +1,3 @@
record_creation_diffs.erl:10: Function foo/1 has no local return
-record_creation_diffs.erl:11: Record construction #bar{some_list::{'this','is','a','tuple'}} violates the declared type of field some_list::'undefined' | [any()]
+record_creation_diffs.erl:11: Record construction #bar{some_list::{'this','is','a','tuple'}} violates the declared type of field some_list::[any()]
diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_pat b/lib/dialyzer/test/small_SUITE_data/results/record_pat
index a46be6c451..8317ea041a 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/record_pat
+++ b/lib/dialyzer/test/small_SUITE_data/results/record_pat
@@ -1,2 +1,2 @@
-record_pat.erl:14: Matching of pattern {'foo', 'baz'} tagged with a record name violates the declared type of #foo{bar::'undefined' | integer()}
+record_pat.erl:14: Matching of pattern {'foo', 'baz'} tagged with a record name violates the declared type of #foo{bar::integer()}
diff --git a/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning b/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning
index 2e417e1b2a..ea3ac92d96 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning
+++ b/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning
@@ -1,3 +1,3 @@
relevant_record_warning.erl:22: Function test/1 has no local return
-relevant_record_warning.erl:23: Record construction #r{field::<<_:8>>} violates the declared type of field field::'binary' | 'undefined'
+relevant_record_warning.erl:23: Record construction #r{field::<<_:8>>} violates the declared type of field field::'binary'
diff --git a/lib/dialyzer/test/small_SUITE_data/results/undefined b/lib/dialyzer/test/small_SUITE_data/results/undefined
new file mode 100644
index 0000000000..9daa8640d3
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/undefined
@@ -0,0 +1,2 @@
+
+r.erl:16: Record construction #r{a::{'fi'},b::{'a','b'},c::[],d::'undefined',e::[],f::'undefined'} violates the declared type of field b::[any()] and d::[any()] and f::[any()]
diff --git a/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl
new file mode 100644
index 0000000000..bc746538d3
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl
@@ -0,0 +1,16 @@
+-module(bif1).
+
+%% Other set of warnings due to removed of functions from
+%% erl_bif_types.
+
+-export([ets_rename/0, string_chars/0]).
+
+ets_rename() ->
+ A = ets:new(fipp, []),
+ true = not is_atom(A),
+ ets:rename(A, fopp). % No warning
+
+string_chars() ->
+ L2 = bif1_adt:opaque_string(),
+ S = $A,
+ string:chars(S, 10, L2). % Warning
diff --git a/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl
new file mode 100644
index 0000000000..01b0bccc68
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl
@@ -0,0 +1,12 @@
+-module(bif1_adt).
+
+-export([opaque_string/0]).
+
+-export_type([s/0]).
+
+-opaque s() :: string().
+
+-spec opaque_string() -> s().
+
+opaque_string() ->
+ "string".
diff --git a/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl b/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl
index ab84e94106..9ad4810a5e 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl
@@ -36,7 +36,7 @@
%% Start of Abstract Format
--type line() :: erl_scan:line().
+-type line() :: erl_anno:line().
-export_type([af_record_index/0, af_record_field/1, af_record_name/0,
af_field_name/0, af_function_decl/0]).
@@ -332,8 +332,8 @@
%% End of Abstract Format
-type error_description() :: term().
--type error_info() :: {erl_scan:line(), module(), error_description()}.
--type token() :: {Tag :: atom(), Line :: erl_scan:line()}.
+-type error_info() :: {erl_anno:line(), module(), error_description()}.
+-type token() :: {Tag :: atom(), Line :: erl_scan:anno()}.
%% mkop(Op, Arg) -> {op,Line,Op,Arg}.
%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl b/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl
index fc7c5241a8..fe567ff10d 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl
@@ -36,7 +36,7 @@
%% Start of Abstract Format
--type line() :: erl_scan:line().
+-type line() :: erl_anno:line().
-export_type([af_module/0, af_export/0, af_import/0, af_fa_list/0,
af_compile/0, af_file/0, af_record_decl/0,
@@ -329,8 +329,8 @@
%% End of Abstract Format
-type error_description() :: term().
--type error_info() :: {erl_scan:line(), module(), error_description()}.
--type token() :: {Tag :: atom(), Line :: erl_scan:line()}.
+-type error_info() :: {erl_anno:line(), module(), error_description()}.
+-type token() :: {Tag :: atom(), Line :: erl_anno:line()}.
%% mkop(Op, Arg) -> {op,Line,Op,Arg}.
%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/trec.erl b/lib/dialyzer/test/small_SUITE_data/src/trec.erl
index 06706162c1..516358f7c6 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/trec.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/trec.erl
@@ -8,7 +8,7 @@
-module(trec).
-export([test/0, mk_foo_exp/2]).
--record(foo, {a :: integer(), b :: [atom()]}).
+-record(foo, {a :: integer() | 'undefined', b :: [atom()]}).
%%
%% For these functions we currently get the following warnings:
diff --git a/lib/dialyzer/test/small_SUITE_data/undefined.erl b/lib/dialyzer/test/small_SUITE_data/undefined.erl
new file mode 100644
index 0000000000..8549f2e161
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/undefined.erl
@@ -0,0 +1,29 @@
+-module(undefined).
+
+-export([t/0]).
+
+%% As of OTP 19.0 'undefined' is no longer added to fields with a type
+%% declaration but without an initializer. The pretty printing of
+%% records (erl_types:t_to_string()) is updated to reflect this: if a
+%% field is of type 'undefined', it is output if 'undefined' is not in
+%% the declared type of the field. (It used to be the case that the
+%% singleton type 'undefined' was never output.)
+%%
+%% One consequence is shown by the example below: the warning about
+%% the record construction violating the the declared type shows
+%% #r{..., d::'undefined', ...} which is meant to be of help to the
+%% user, who could otherwise get confused the first time (s)he gets
+%% confronted by the warning.
+
+-record(r,
+ {
+ a = {fi},
+ b = {a,b} :: list(), % violation
+ c = {a,b} :: list(),
+ d :: list(), % violation
+ e = [] :: list(),
+ f = undefined :: list() % violation
+ }).
+
+t() ->
+ #r{c = []}.
diff --git a/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu b/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu
index d1f8f4caf2..626e677524 100644
--- a/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu
+++ b/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu
@@ -6,7 +6,7 @@ wsp_pdu.erl:2403: The call wsp_pdu:d_date(Data1::binary()) will never return sin
wsp_pdu.erl:2406: Guard test is_integer(Sec::{[byte()] | byte() | {'long',binary()} | {'short',binary()},binary()}) can never succeed
wsp_pdu.erl:2408: The pattern {'short', Data2} can never match the type {[byte()] | byte() | {'long',binary()} | {'short',binary()},binary()}
wsp_pdu.erl:2755: Function parse_push_flag/1 has no local return
-wsp_pdu.erl:2756: The call erlang:integer_to_list(Value::[any()]) breaks the contract (Integer) -> string() when is_subtype(Integer,integer())
+wsp_pdu.erl:2756: The call erlang:integer_to_list(Value::[any()]) breaks the contract (Integer) -> string() when Integer :: integer()
wsp_pdu.erl:2875: The call wsp_pdu:d_text_string(Data::byte()) will never return since it differs in the 1st argument from the success typing arguments: (binary())
wsp_pdu.erl:2976: The call wsp_pdu:d_q_value(QData::byte()) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>>)
wsp_pdu.erl:3336: The call wsp_pdu:encode_typed_field(Ver::any(),'Q-value',ParamValue::any()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),'Constrained-encoding' | 'Date-value' | 'No-value' | 'Short-integer' | 'Text-string' | 'Text-value' | 'Well-known-charset',any())
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index 2b23183d18..fb874013a3 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -117,7 +117,7 @@
parent :: pid(), %% watchdog process
transport :: pid(), %% transport process
dictionary :: module(), %% common dictionary
- service :: #diameter_service{},
+ service :: #diameter_service{} | undefined,
dpr = false :: false
| true %% DPR received, DPA sent
| {boolean(), uint32(), uint32()},
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index d49176ec3e..58b1cd742b 100644
--- a/lib/diameter/src/base/diameter_service.erl
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -137,7 +137,7 @@
%% Record representing an RFC 3539 watchdog process implemented by
%% diameter_watchdog.
-record(watchdog,
- {pid :: match(pid()),
+ {pid :: match(pid()) | undefined,
type :: match(connect | accept),
ref :: match(reference()), %% key into diameter_config
options :: match([diameter:transport_opt()]),%% from start_transport
diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl
index 678dc9b5d6..8a80ce630a 100644
--- a/lib/diameter/src/transport/diameter_sctp.erl
+++ b/lib/diameter/src/transport/diameter_sctp.erl
@@ -84,16 +84,18 @@
%% Accepting/connecting transport process state.
-record(transport,
- {parent :: pid(),
+ {parent :: pid() | undefined,
mode :: {accept, pid()}
| accept
| {connect, {[inet:ip_address()], uint(), list()}}
%% {RAs, RP, Errors}
| connect,
- socket :: gen_sctp:sctp_socket(),
+ socket :: gen_sctp:sctp_socket() | undefined,
assoc_id :: gen_sctp:assoc_id(), %% association identifier
- peer :: {[inet:ip_address()], uint()}, %% {RAs, RP}
- streams :: {uint(), uint()}, %% {InStream, OutStream} counts
+ peer :: {[inet:ip_address()], uint()} %% {RAs, RP}
+ | undefined,
+ streams :: {uint(), uint()} %% {InStream, OutStream} counts
+ | undefined,
os = 0 :: uint()}). %% next output stream
%% Listener process state.
@@ -102,7 +104,7 @@
socket :: gen_sctp:sctp_socket(),
count = 0 :: uint(), %% attached transport processes
pending = {0, queue:new()},
- tref :: reference(),
+ tref :: reference() | undefined,
accept :: [match()]}).
%% Field pending implements two queues: the first of transport-to-be
%% processes to which an association has been assigned but for which
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index 005b2442c0..c79d85820b 100644
--- a/lib/diameter/src/transport/diameter_tcp.erl
+++ b/lib/diameter/src/transport/diameter_tcp.erl
@@ -73,7 +73,7 @@
%% Listener process state.
-record(listener, {socket :: inet:socket(),
count = 1 :: non_neg_integer(),
- tref :: reference()}).
+ tref :: reference() | undefined}).
%% Monitor process state.
-record(monitor,
diff --git a/lib/edoc/test/Makefile b/lib/edoc/test/Makefile
index 2033e003b3..7a03ddeba9 100644
--- a/lib/edoc/test/Makefile
+++ b/lib/edoc/test/Makefile
@@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/edoc_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/edoc/test/edoc_SUITE.erl b/lib/edoc/test/edoc_SUITE.erl
index 2e2d5584f0..00d7550bed 100644
--- a/lib/edoc/test/edoc_SUITE.erl
+++ b/lib/edoc/test/edoc_SUITE.erl
@@ -16,7 +16,7 @@
%%
-module(edoc_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl
index 0c03021bd0..dc236f8a44 100644
--- a/lib/eldap/src/eldap.erl
+++ b/lib/eldap/src/eldap.erl
@@ -272,7 +272,7 @@ modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup, Controls)
%%% Sanity checks !
-bool_p(Bool) when Bool==true;Bool==false -> Bool.
+bool_p(Bool) when is_boolean(Bool) -> Bool.
optional([]) -> asn1_NOVALUE;
optional(Value) -> Value.
@@ -1101,10 +1101,13 @@ log(_, _, _, _) ->
%%% Misc. routines
%%% --------------------------------------------------------------------
-send(To,Msg) -> To ! {self(),Msg}.
+send(To,Msg) ->
+ To ! {self(), Msg},
+ ok.
+
recv(From) ->
receive
- {From,Msg} -> Msg;
+ {From, Msg} -> Msg;
{'EXIT', From, Reason} ->
{error, {internal_error, Reason}}
end.
diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl
index 8414ca6e46..4c1c2f8144 100644
--- a/lib/eldap/test/eldap_basic_SUITE.erl
+++ b/lib/eldap/test/eldap_basic_SUITE.erl
@@ -23,7 +23,7 @@
-compile(export_all).
%%-include_lib("common_test/include/ct.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("eldap/include/eldap.hrl").
-include_lib("eldap/ebin/ELDAPv3.hrl").
diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css
index 0b531db701..347782eb1e 100644
--- a/lib/erl_docgen/priv/css/otp_doc.css
+++ b/lib/erl_docgen/priv/css/otp_doc.css
@@ -37,7 +37,7 @@ a:visited { color: blue; text-decoration: none }
top: 0;
bottom: 0;
left: 0;
- width: 200px;
+ width: 300px;
overflow:auto;
margin: 0;
padding: 1px;
@@ -45,7 +45,7 @@ a:visited { color: blue; text-decoration: none }
}
#content {
- margin-left: 240px; /* set left value to WidthOfFrameDiv */
+ margin-left: 340px; /* set left value to WidthOfFrameDiv */
}
.frontpage
diff --git a/lib/erl_docgen/test/Makefile b/lib/erl_docgen/test/Makefile
index 9f4cc04105..9e58157023 100644
--- a/lib/erl_docgen/test/Makefile
+++ b/lib/erl_docgen/test/Makefile
@@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/erl_docgen_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in
index 777d709b1e..d6176ec053 100644
--- a/lib/erl_interface/src/Makefile.in
+++ b/lib/erl_interface/src/Makefile.in
@@ -126,11 +126,7 @@ else
WARNFLAGS = @WFLAGS@
endif
-ifneq ($(findstring ose,$(TARGET)),ose)
CFLAGS = @LIB_CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS)
-else
-CFLAGS = @CFLAGS@ $(INCFLAGS)
-endif
PROG_CFLAGS = @CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS) -Ilegacy
ifeq ($(findstring vxworks,$(TARGET)),vxworks)
@@ -210,12 +206,8 @@ MDD_ERLLIB = $(OBJDIR)/$(LIBPRE)erl_interface_mdd$(LIBEXT)
# Specify targets to build
###########################################################################
-ifneq ($(findstring ose,$(TARGET)),ose)
EXE_TARGETS = \
$(ERL_CALL)
-else
-EXE_TARGETS =
-endif
ifeq ($(USING_VC),yes)
@@ -480,44 +472,6 @@ ERLSOURCES = \
SOURCES = $(EISOURCES) $(ERLSOURCES)
-OSE_EISOURCES = \
- $(DECODESRC) \
- $(ENCODESRC) \
- misc/ei_decode_term.c \
- misc/ei_format.c \
- misc/ei_locking.c \
- misc/ei_malloc.c \
- misc/ei_printterm.c \
- misc/ei_pthreads.c \
- misc/ei_trace.c \
- misc/ei_x_encode.c \
- misc/eimd5.c \
- misc/get_type.c \
- misc/show_msg.c \
- misc/ei_compat.c \
- registry/hash_dohash.c \
- registry/hash_foreach.c \
- registry/hash_freetab.c \
- registry/hash_insert.c \
- registry/hash_isprime.c \
- registry/hash_lookup.c \
- registry/hash_newtab.c \
- registry/hash_remove.c \
- registry/hash_resize.c \
- registry/hash_rlookup.c
-
-OSE_ERLSOURCES = \
- legacy/decode_term.c \
- legacy/encode_term.c \
- legacy/erl_error.c \
- legacy/erl_eterm.c \
- legacy/erl_fix_alloc.c \
- legacy/erl_format.c \
- legacy/erl_malloc.c \
- legacy/erl_marshal.c
-
-OSE_SOURCES = $(OSE_EISOURCES) $(OSE_ERLSOURCES)
-
NEVERUSED = \
whereis.c \
ei_send.c \
@@ -532,13 +486,8 @@ ERLCALL = \
# Note that encode/decode_term.c defines ei functions that is
# located in the erl_interface library, not ei library.
-ifneq ($(findstring ose,$(TARGET)),ose)
ST_EIOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(EISOURCES:.c=.o)))
ST_ERLOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(ERLSOURCES:.c=.o)))
-else
-ST_EIOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(OSE_EISOURCES:.c=.o)))
-ST_ERLOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(OSE_ERLSOURCES:.c=.o)))
-endif
MT_EIOBJECTS = $(addprefix $(MT_OBJDIR)/,$(notdir $(EISOURCES:.c=.o)))
MT_ERLOBJECTS = $(addprefix $(MT_OBJDIR)/,$(notdir $(ERLSOURCES:.c=.o)))
MD_EIOBJECTS = $(addprefix $(MD_OBJDIR)/,$(notdir $(EISOURCES:.c=.o)))
@@ -587,14 +536,6 @@ $(TARGET)/config.h:
$(V_at)echo "#define HAVE_SOCKLEN_T 1" >> $@
endif
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(TARGET)/config.h:
- $(gen_verbose)
- $(V_at)echo "/* Generated by Makefile */" > $@
- $(V_at)echo "#define HAVE_STRERROR 1" >> $@
- $(V_at)echo "#define HAVE_SOCKLEN_T 1" >> $@
-endif
-
###########################################################################
# Default rules, normal and threaded
###########################################################################
@@ -719,9 +660,6 @@ $(ST_OBJDIR)/erl_start.o: prog/erl_start.c
$(V_CC) $(CFLAGS) -c $< -o $@
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(ERL_CALL):
-else
ifdef THR_DEFS
$(ERL_CALL): $(ERLCALL) ../include/ei.h $(MT_EILIB)
$(ld_verbose)$(PURIFY) $(CC) $(PROG_CFLAGS) $(THR_DEFS) $(LDFLAGS) -o $@ $(ERLCALL) \
@@ -733,7 +671,6 @@ $(ERL_CALL): $(ERLCALL) ../include/ei.h $(ST_EILIB)
endif
endif
endif
-endif
###########################################################################
# Fake application targets used to test header files and linking
diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl
index 144ec99e0a..db3587339e 100644
--- a/lib/erl_interface/test/ei_accept_SUITE.erl
+++ b/lib/erl_interface/test/ei_accept_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(ei_accept_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("ei_accept_SUITE_data/ei_accept_test_cases.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl
index 3385d1eb6c..c94ac37af4 100644
--- a/lib/erl_interface/test/ei_connect_SUITE.erl
+++ b/lib/erl_interface/test/ei_connect_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(ei_connect_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("ei_connect_SUITE_data/ei_connect_test_cases.hrl").
-export([
diff --git a/lib/erl_interface/test/ei_decode_SUITE.erl b/lib/erl_interface/test/ei_decode_SUITE.erl
index 0abcf50fb5..91357c99f2 100644
--- a/lib/erl_interface/test/ei_decode_SUITE.erl
+++ b/lib/erl_interface/test/ei_decode_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(ei_decode_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("ei_decode_SUITE_data/ei_decode_test_cases.hrl").
-export(
diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl
index 3c7e4bf70d..6a25b98209 100644
--- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl
+++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(ei_decode_encode_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("ei_decode_encode_SUITE_data/ei_decode_encode_test_cases.hrl").
-export(
diff --git a/lib/erl_interface/test/ei_encode_SUITE.erl b/lib/erl_interface/test/ei_encode_SUITE.erl
index 6213916314..d94f3adf42 100644
--- a/lib/erl_interface/test/ei_encode_SUITE.erl
+++ b/lib/erl_interface/test/ei_encode_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(ei_encode_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("ei_encode_SUITE_data/ei_encode_test_cases.hrl").
-export(
diff --git a/lib/erl_interface/test/ei_format_SUITE.erl b/lib/erl_interface/test/ei_format_SUITE.erl
index 11cbae31db..ed6a755f9b 100644
--- a/lib/erl_interface/test/ei_format_SUITE.erl
+++ b/lib/erl_interface/test/ei_format_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(ei_format_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("ei_format_SUITE_data/ei_format_test_cases.hrl").
-export([
diff --git a/lib/erl_interface/test/ei_print_SUITE.erl b/lib/erl_interface/test/ei_print_SUITE.erl
index 4309b883bb..36ee90c7ee 100644
--- a/lib/erl_interface/test/ei_print_SUITE.erl
+++ b/lib/erl_interface/test/ei_print_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(ei_print_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("ei_print_SUITE_data/ei_print_test_cases.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/erl_interface/test/ei_tmo_SUITE.erl b/lib/erl_interface/test/ei_tmo_SUITE.erl
index 689499f42f..f506b3dbb0 100644
--- a/lib/erl_interface/test/ei_tmo_SUITE.erl
+++ b/lib/erl_interface/test/ei_tmo_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(ei_tmo_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/inet.hrl").
-include("ei_tmo_SUITE_data/ei_tmo_test_cases.hrl").
diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl
index f621310a1c..d3fe020bce 100644
--- a/lib/erl_interface/test/erl_connect_SUITE.erl
+++ b/lib/erl_interface/test/erl_connect_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(erl_connect_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("erl_connect_SUITE_data/erl_connect_test_cases.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl
index 8fbef35309..230310f63b 100644
--- a/lib/erl_interface/test/erl_eterm_SUITE.erl
+++ b/lib/erl_interface/test/erl_eterm_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(erl_eterm_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("erl_eterm_SUITE_data/eterm_test_cases.hrl").
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/erl_interface/test/erl_ext_SUITE.erl b/lib/erl_interface/test/erl_ext_SUITE.erl
index f73c15e15f..cbc93b4cfb 100644
--- a/lib/erl_interface/test/erl_ext_SUITE.erl
+++ b/lib/erl_interface/test/erl_ext_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(erl_ext_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("erl_ext_SUITE_data/ext_test_cases.hrl").
-export([
diff --git a/lib/erl_interface/test/erl_format_SUITE.erl b/lib/erl_interface/test/erl_format_SUITE.erl
index 8c01a9914f..afbbe6a241 100644
--- a/lib/erl_interface/test/erl_format_SUITE.erl
+++ b/lib/erl_interface/test/erl_format_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(erl_format_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("erl_format_SUITE_data/format_test_cases.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/erl_interface/test/erl_global_SUITE.erl b/lib/erl_interface/test/erl_global_SUITE.erl
index b719ad5c6a..493ad576c9 100644
--- a/lib/erl_interface/test/erl_global_SUITE.erl
+++ b/lib/erl_interface/test/erl_global_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(erl_global_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("erl_global_SUITE_data/erl_global_test_cases.hrl").
-export([all/0,suite/0,init_per_suite/1,end_per_suite/1,
diff --git a/lib/erl_interface/test/erl_match_SUITE.erl b/lib/erl_interface/test/erl_match_SUITE.erl
index d8f7bd89b4..ecdebad212 100644
--- a/lib/erl_interface/test/erl_match_SUITE.erl
+++ b/lib/erl_interface/test/erl_match_SUITE.erl
@@ -21,7 +21,7 @@
%%
-module(erl_match_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("erl_match_SUITE_data/match_test_cases.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/erl_interface/test/port_call_SUITE.erl b/lib/erl_interface/test/port_call_SUITE.erl
index b0f5ed4fe9..3bc1a03eab 100644
--- a/lib/erl_interface/test/port_call_SUITE.erl
+++ b/lib/erl_interface/test/port_call_SUITE.erl
@@ -34,7 +34,7 @@
-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]).
% Private exports
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl
index f3e58a3d1c..1b468551d8 100644
--- a/lib/eunit/src/eunit_surefire.erl
+++ b/lib/eunit/src/eunit_surefire.erl
@@ -56,7 +56,11 @@
{
name :: chars(),
description :: chars(),
- result :: ok | {failed, tuple()} | {aborted, tuple()} | {skipped, term()},
+ result :: ok
+ | {failed, tuple()}
+ | {aborted, tuple()}
+ | {skipped, term()}
+ | undefined,
time :: integer(),
output :: binary()
}).
diff --git a/lib/eunit/test/Makefile b/lib/eunit/test/Makefile
index 8721bacf89..6f166f99aa 100644
--- a/lib/eunit/test/Makefile
+++ b/lib/eunit/test/Makefile
@@ -41,8 +41,8 @@ RELSYSDIR = $(RELEASE_PATH)/eunit_test
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
-ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_MAKE_FLAGS +=
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/gs/Makefile b/lib/gs/Makefile
index 02c8fc3467..b95d435461 100644
--- a/lib/gs/Makefile
+++ b/lib/gs/Makefile
@@ -26,7 +26,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
# Macros
#
-SUB_DIRECTORIES = src tcl contribs examples doc/src
+SUB_DIRECTORIES = src tcl examples doc/src
include vsn.mk
VSN = $(GS_VSN)
diff --git a/lib/gs/contribs/Makefile b/lib/gs/contribs/Makefile
deleted file mode 100644
index 061fae86c1..0000000000
--- a/lib/gs/contribs/Makefile
+++ /dev/null
@@ -1,32 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2009. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-SUB_DIRECTORIES = bonk cols mandel othello
-SPECIAL_TARGETS =
-
-#
-# Default Subdir Targets
-#
-include $(ERL_TOP)/make/otp_subdir.mk
-
diff --git a/lib/gs/contribs/bonk/Makefile b/lib/gs/contribs/bonk/Makefile
deleted file mode 100644
index b7508a97c9..0000000000
--- a/lib/gs/contribs/bonk/Makefile
+++ /dev/null
@@ -1,109 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2012. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(GS_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= \
- bonk \
- bonk_sound \
- bonk_square \
- sounder
-
-HRL_FILES=
-ERL_FILES= $(MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES)
-
-BITMAPS= bitmaps/bonkbomb bitmaps/bonkface bitmaps/bonklogo bitmaps/bonkmiss \
- bitmaps/bonktom bitmaps/bonkx bitmaps/erl-e bitmaps/erl-text
-SOUNDS= sounds/bonk.au sounds/damn.au sounds/explosion.au sounds/gameover.au \
- sounds/hehee.au sounds/level.au sounds/missedme.au sounds/music.au \
- sounds/ouch!!!.au sounds/praisejesus.au sounds/trumpet.au sounds/yes.au
-
-TOOLNAME = bonk
-
-EXTRA_FILES= $(TOOLNAME).txt
-TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif
-TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_COMPILE_FLAGS +=
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-debug opt: $(TARGET_FILES)
-
-docs:
-
-clean:
- rm -f $(TARGET_FILES)
- rm -f core
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-
-$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif
- $(gen_verbose)rm -f $@
- $(V_at)cp $(TOOLNAME).gif $@
-
-$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool
- $(gen_verbose)rm -f $@
- $(V_at)cp $(TOOLNAME).tool $@
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/bonk/bitmaps"
- $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/bonk/bitmaps"
- $(INSTALL_DIR) "$(RELSYSDIR)/bonk/sounds"
- $(INSTALL_DATA) $(SOUNDS) "$(RELSYSDIR)/bonk/sounds"
- $(INSTALL_DIR) "$(RELSYSDIR)/bonk"
- $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/bonk"
-
-
-release_docs_spec:
-
diff --git a/lib/gs/contribs/bonk/bitmaps/bonkbomb b/lib/gs/contribs/bonk/bitmaps/bonkbomb
deleted file mode 100644
index 8b121db9e8..0000000000
--- a/lib/gs/contribs/bonk/bitmaps/bonkbomb
+++ /dev/null
@@ -1,66 +0,0 @@
-#define bonkbomb_width 75
-#define bonkbomb_height 75
-static char bonkbomb_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x04, 0x10, 0x82, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08,
- 0x10, 0x42, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x10, 0x21,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x10, 0x11, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x90, 0x08, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x80, 0x90, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x04, 0x51, 0x82, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18,
- 0x12, 0x61, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x94, 0x18,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x41, 0x06, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xfc, 0xbb, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80,
- 0x99, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x18, 0x19,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x30, 0x62, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x30, 0x84, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x80, 0x30, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xc0, 0x31, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0,
- 0x3b, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x70, 0x1f, 0x40,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03, 0xb8, 0x0e, 0x80, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xfc, 0x7f, 0x5c, 0x1d, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xff, 0xff, 0xaf, 0x3a, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff,
- 0xff, 0x57, 0x35, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xaf,
- 0x3a, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x5f, 0x1d, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xbf, 0x0e, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xfc, 0xff, 0xff, 0x7f, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xfe, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff,
- 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xfe, 0xff, 0xff,
- 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xfe, 0xff, 0xff, 0x01, 0x00,
- 0x00, 0x00, 0x00, 0x80, 0x7f, 0xfc, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00,
- 0x00, 0x80, 0x3f, 0xf8, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80,
- 0x0f, 0xf0, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0x3f, 0xc0,
- 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0x7f, 0xf0, 0xff, 0xff,
- 0x03, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf8, 0xff, 0xff, 0x07, 0x00,
- 0x00, 0x00, 0x00, 0xc0, 0xff, 0xfd, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00,
- 0x00, 0xc0, 0xff, 0xfd, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x80,
- 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff,
- 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff,
- 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03, 0x00,
- 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff,
- 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x7f, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xf0, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xe0, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff,
- 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0x01,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/lib/gs/contribs/bonk/bitmaps/bonkface b/lib/gs/contribs/bonk/bitmaps/bonkface
deleted file mode 100644
index 964fb93098..0000000000
--- a/lib/gs/contribs/bonk/bitmaps/bonkface
+++ /dev/null
@@ -1,66 +0,0 @@
-#define bonkface_width 75
-#define bonkface_height 75
-static char bonkface_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x80, 0x01, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00,
- 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00,
- 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x40, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00,
- 0x02, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x01, 0x08,
- 0x00, 0x80, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x01, 0x30, 0x00, 0x60,
- 0x00, 0x04, 0x00, 0x00, 0x00, 0x80, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x08,
- 0x00, 0x00, 0x00, 0x80, 0x07, 0x00, 0x03, 0x06, 0x00, 0x0f, 0x00, 0x00,
- 0x00, 0x40, 0xff, 0x00, 0x00, 0x00, 0xf8, 0x17, 0x00, 0x00, 0x00, 0x40,
- 0xfe, 0x1f, 0x00, 0xc0, 0xff, 0x13, 0x00, 0x00, 0x00, 0x20, 0xf8, 0xff,
- 0x03, 0xfe, 0xff, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0xff, 0xff,
- 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xc0, 0xff, 0xdf, 0xff, 0x1f, 0x20,
- 0x00, 0x00, 0x00, 0x20, 0x00, 0xff, 0xdf, 0xff, 0x07, 0x20, 0x00, 0x00,
- 0x00, 0x10, 0x00, 0xfe, 0x8f, 0xff, 0x03, 0x40, 0x00, 0x00, 0x00, 0x10,
- 0x00, 0xf8, 0x8f, 0xff, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xf0,
- 0x07, 0x7f, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xc0, 0x07, 0x1f,
- 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x03, 0x06, 0x00, 0x40,
- 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00,
- 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xe0,
- 0x00, 0x38, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0xf0, 0x01, 0x7c,
- 0x40, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0x00, 0x06, 0x03, 0x40, 0x40,
- 0x00, 0x00, 0x00, 0x10, 0x10, 0x00, 0xf8, 0x00, 0x40, 0x40, 0x00, 0x00,
- 0x00, 0x10, 0x30, 0x00, 0x00, 0x00, 0x60, 0x40, 0x00, 0x00, 0x00, 0x10,
- 0x70, 0x00, 0x00, 0x00, 0x70, 0x40, 0x00, 0x00, 0x00, 0x10, 0xf0, 0x01,
- 0x00, 0x00, 0x7c, 0x40, 0x00, 0x00, 0x00, 0x20, 0xf0, 0x0f, 0x00, 0x80,
- 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0x03, 0xfe, 0x7f, 0x20,
- 0x00, 0x00, 0x00, 0x20, 0xf0, 0x7f, 0xfe, 0xff, 0x7f, 0x20, 0x00, 0x00,
- 0x00, 0x20, 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x20, 0x00, 0x00, 0x00, 0x40,
- 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x10, 0x00, 0x00, 0x00, 0x40, 0xc0, 0xff,
- 0xff, 0xff, 0x1f, 0x10, 0x00, 0x00, 0x00, 0x80, 0xc0, 0xff, 0xff, 0xff,
- 0x1f, 0x08, 0x00, 0x00, 0x00, 0x80, 0x80, 0xff, 0xff, 0xff, 0x0f, 0x08,
- 0x00, 0x00, 0x00, 0x00, 0x01, 0xff, 0xff, 0xff, 0x07, 0x04, 0x00, 0x00,
- 0x00, 0x00, 0x01, 0xfe, 0xff, 0xff, 0x03, 0x04, 0x00, 0x00, 0x00, 0x00,
- 0x02, 0xfc, 0xff, 0xfc, 0x01, 0x02, 0x00, 0x00, 0x00, 0x00, 0x04, 0xf0,
- 0xff, 0x7c, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x08, 0xc0, 0xff, 0x1c,
- 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0xff, 0x07, 0x40, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x80, 0x01, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06,
- 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0xc0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/lib/gs/contribs/bonk/bitmaps/bonklogo b/lib/gs/contribs/bonk/bitmaps/bonklogo
deleted file mode 100644
index 3adc59984a..0000000000
--- a/lib/gs/contribs/bonk/bitmaps/bonklogo
+++ /dev/null
@@ -1,320 +0,0 @@
-#define bonklogo_width 300
-#define bonklogo_height 100
-static char bonklogo_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x3f, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, 0x00,
- 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0,
- 0x83, 0xff, 0x9f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x3c, 0xf8, 0xff, 0x7f, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x87, 0xff, 0xff, 0xff, 0x08, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x80, 0xf9, 0xff, 0xff, 0xff, 0x13, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0x27,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff,
- 0xff, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff,
- 0xff, 0xff, 0xff, 0x9f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x80, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x01, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x02, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff,
- 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0x0f,
- 0xfe, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff,
- 0xff, 0x2f, 0xf8, 0xff, 0x05, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x80, 0xdf, 0xff, 0x2f, 0xf0, 0xff, 0x0d, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x80, 0xc3, 0xff, 0x2f, 0xf0, 0xff, 0x09, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x80, 0xc0, 0xff, 0x2f, 0xe0, 0xff, 0x0b, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x01, 0x00, 0x80, 0xff, 0x09,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x2f, 0xc0, 0xff,
- 0x0b, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0xc0,
- 0xff, 0x05, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x27,
- 0xc0, 0xff, 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0x01,
- 0x00, 0xc0, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0,
- 0xff, 0x17, 0xc0, 0xff, 0x17, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc,
- 0x7f, 0x01, 0x00, 0xe0, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xe0, 0xff, 0x17, 0xc0, 0xff, 0x17, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xfc, 0x7f, 0x01, 0x00, 0xe0, 0xff, 0x02, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xfc, 0x7f, 0xff, 0x3f, 0xe0, 0x7f, 0x02, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xc0,
- 0xff, 0x7f, 0xe0, 0xff, 0x3f, 0xfc, 0x7f, 0x00, 0x20, 0xe0, 0x7f, 0x01,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff,
- 0x17, 0x00, 0x00, 0x80, 0x00, 0x00, 0x20, 0xfc, 0x7f, 0xfe, 0x2f, 0xf0,
- 0x3f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17,
- 0x80, 0xff, 0x17, 0xe0, 0xff, 0x1f, 0xe1, 0xff, 0x2f, 0xfc, 0x7f, 0xfe,
- 0x2f, 0xf0, 0x3f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0,
- 0xff, 0x17, 0x80, 0xff, 0x17, 0xf0, 0xff, 0x7f, 0xe6, 0xff, 0x4f, 0xfc,
- 0x7f, 0xfe, 0x2f, 0xf0, 0xbf, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xf8, 0xff, 0xff, 0xe8, 0xff,
- 0x4f, 0xfc, 0x7f, 0xfe, 0x2f, 0xf8, 0x9f, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xfe, 0xff, 0xff,
- 0xeb, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, 0x2f, 0xf8, 0x9f, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xfe,
- 0xff, 0xff, 0xe3, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, 0x2f, 0xf8, 0x5f, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0xc0, 0xff,
- 0x17, 0xff, 0xff, 0xff, 0xe7, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, 0x2f, 0xfc,
- 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17,
- 0xc0, 0xff, 0x93, 0xff, 0xff, 0xff, 0xe7, 0xff, 0x5f, 0xfc, 0x7f, 0xfe,
- 0x2f, 0xfc, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0,
- 0xff, 0x17, 0xc0, 0xff, 0x8b, 0xff, 0xff, 0xff, 0xe7, 0xff, 0x9f, 0xfc,
- 0x7f, 0xfe, 0x2f, 0xfc, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xe0, 0xff, 0x13, 0xe0, 0xff, 0x8b, 0xff, 0xff, 0xff, 0xcf, 0xff,
- 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfc, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0xff, 0x0b, 0xf2, 0xff, 0xcd, 0xff, 0xff, 0xff,
- 0xcf, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfe, 0x17, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x0b, 0xf9, 0xff, 0xd9, 0xff,
- 0xff, 0xff, 0x1f, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfe, 0x13, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xcb, 0xfc, 0xff,
- 0xc0, 0xff, 0x8f, 0xff, 0x1f, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfe,
- 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x2b,
- 0xfe, 0xff, 0x87, 0xff, 0x03, 0xff, 0x3f, 0xff, 0xbf, 0xfc, 0x7f, 0xfe,
- 0x2f, 0xff, 0x0b, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0xff, 0x9b, 0xff, 0xff, 0x3f, 0xff, 0x01, 0xfe, 0x3f, 0xff, 0x3f, 0xfd,
- 0x7f, 0xfe, 0x2f, 0xff, 0x09, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0xff, 0xc3, 0xff, 0xff, 0x7f, 0xfe, 0x05, 0xfc, 0x3f, 0xff,
- 0x7f, 0xfd, 0x7f, 0xfe, 0x2f, 0xff, 0x09, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0xff, 0xfb, 0xff, 0xff, 0xff, 0xfc, 0x04, 0xfc,
- 0x3f, 0xff, 0x7f, 0xfd, 0x7f, 0xfe, 0x2f, 0xff, 0x04, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xfc,
- 0x02, 0xf8, 0x3f, 0xff, 0x7f, 0xfd, 0x7f, 0xfe, 0xaf, 0xff, 0x04, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xfd, 0x02, 0xf8, 0x3f, 0xff, 0x7f, 0xfc, 0x7f, 0xfe, 0xaf, 0xff,
- 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xf9, 0x02, 0xf8, 0x3f, 0xff, 0x7f, 0xfc, 0x7f, 0xfe,
- 0x8f, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xfb, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfc,
- 0x7f, 0xfe, 0xcf, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf3, 0x02, 0xf8, 0x3f, 0xff,
- 0xff, 0xfc, 0x7f, 0xfe, 0xcf, 0x7f, 0x01, 0x00, 0x00, 0x38, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf3, 0x02, 0xf8,
- 0x3f, 0xff, 0xff, 0xfc, 0x7f, 0xfe, 0xcf, 0x3f, 0x01, 0x00, 0x00, 0x38,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0xf7,
- 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfc, 0x7f, 0xfe, 0xef, 0x3f, 0x01, 0x00,
- 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x03, 0x80, 0xff,
- 0xff, 0xe7, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfc, 0x7f, 0xfe, 0xef, 0x9f,
- 0x00, 0x00, 0x00, 0x00, 0x98, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x01,
- 0x00, 0xff, 0xff, 0xe7, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe,
- 0xef, 0xdf, 0x00, 0x00, 0x00, 0x30, 0xd8, 0x07, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8,
- 0xff, 0x05, 0x00, 0xff, 0xff, 0xe7, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd,
- 0x7f, 0xfe, 0xef, 0x9f, 0x00, 0x00, 0x00, 0x38, 0xfc, 0x07, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf8, 0xff, 0x05, 0x00, 0xff, 0xff, 0xef, 0x02, 0xf8, 0x3f, 0xff,
- 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0xbf, 0x00, 0x00, 0x00, 0x38, 0x7c, 0x0e,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf8, 0xff, 0x05, 0x00, 0xfe, 0xff, 0xef, 0x02, 0xf8,
- 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x38,
- 0x3e, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x05, 0x00, 0xfe, 0xff, 0xef,
- 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0x7f, 0x02, 0x00,
- 0x00, 0x38, 0x3e, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x05, 0x00, 0xfc,
- 0xff, 0xcf, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0xff,
- 0x02, 0x00, 0x00, 0x38, 0x3b, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x04,
- 0x00, 0xfc, 0xff, 0xcf, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xff, 0x7f, 0xfe,
- 0xff, 0xff, 0x04, 0x00, 0x00, 0xb8, 0x39, 0x2e, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8,
- 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xff,
- 0x7f, 0xfe, 0xff, 0xff, 0x05, 0x00, 0x00, 0xf0, 0x39, 0x3c, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf8, 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, 0x04, 0xf8, 0x3f, 0xff,
- 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x09, 0x00, 0x00, 0xf0, 0x38, 0x1c,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf8, 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, 0x05, 0xf8,
- 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x13, 0x00, 0x00, 0x60,
- 0x08, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf,
- 0x0d, 0xf8, 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x17, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfe,
- 0xff, 0xcf, 0x09, 0xfd, 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff,
- 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02,
- 0x00, 0xfe, 0xff, 0xcf, 0xcb, 0xfc, 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe,
- 0xff, 0xff, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc,
- 0xff, 0x02, 0x00, 0xfe, 0xff, 0xcf, 0x33, 0xfe, 0x3f, 0xff, 0xf9, 0xff,
- 0x7f, 0xfe, 0xff, 0xff, 0x5f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfe, 0xff, 0xcf, 0x07, 0xff, 0x3f, 0xff,
- 0xf9, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x9f, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfe, 0xff, 0xcf, 0xcf, 0xff,
- 0x3f, 0xff, 0xf9, 0xff, 0x7f, 0xfe, 0x7f, 0xff, 0x3f, 0x01, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x40, 0xfe, 0xff, 0xcf,
- 0xff, 0xff, 0x3f, 0xff, 0xf9, 0xff, 0x7f, 0xfe, 0x7f, 0xfe, 0x3f, 0x01,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x3c, 0xff,
- 0xff, 0xc7, 0xff, 0xff, 0x3f, 0xff, 0xf9, 0xff, 0x7f, 0xfe, 0x7f, 0xfe,
- 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x82,
- 0x87, 0xff, 0xff, 0xe7, 0xff, 0xff, 0x3f, 0xff, 0xf1, 0xff, 0x7f, 0xfe,
- 0x3f, 0xfc, 0xff, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc,
- 0xff, 0x72, 0xf0, 0xff, 0xff, 0xe7, 0xff, 0xff, 0x3f, 0xff, 0xf1, 0xff,
- 0x7f, 0xfe, 0xbf, 0xf8, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xfc, 0xff, 0x0e, 0xff, 0xff, 0xff, 0xe7, 0xff, 0xff, 0x9f, 0xff,
- 0xf5, 0xff, 0x7f, 0xfe, 0xbf, 0xf8, 0xff, 0x09, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xfc, 0xff, 0xe0, 0xff, 0xff, 0xff, 0xe7, 0xff, 0xff,
- 0x9f, 0xff, 0xf5, 0xff, 0x7f, 0xfe, 0x9f, 0xf0, 0xff, 0x0b, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xe7,
- 0xff, 0xff, 0x9f, 0xff, 0xf5, 0xff, 0x7f, 0xfe, 0x5f, 0xf0, 0xff, 0x13,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xfe, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xf3, 0xff, 0xff, 0xdf, 0xff, 0xf5, 0xff, 0x7f, 0xfe, 0x4f, 0xe0,
- 0xff, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0xfe, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xf3, 0xff, 0xff, 0xcf, 0xff, 0xe5, 0xff, 0x7f, 0xfe,
- 0x2f, 0xe0, 0xff, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xf3, 0xff, 0xff, 0xcf, 0xff, 0xe5, 0xff,
- 0x7f, 0xfe, 0x2f, 0xc0, 0xff, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf1, 0xff, 0xff, 0xe7, 0xff,
- 0xe5, 0xff, 0x7f, 0xfe, 0x2f, 0xc0, 0xff, 0x9f, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0xf8, 0xff, 0xff,
- 0xe7, 0xff, 0xe5, 0xff, 0x7f, 0xfe, 0x2f, 0x80, 0xff, 0x9f, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0xfc,
- 0xff, 0xff, 0xf7, 0xff, 0xe5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xff, 0x3f,
- 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff,
- 0x1f, 0xfe, 0xff, 0xff, 0xf3, 0xff, 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00,
- 0xff, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0x0f, 0xff, 0xff, 0xff, 0xf3, 0xff, 0xc5, 0xff, 0x7f, 0xfe,
- 0x2f, 0x00, 0xfe, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0x23, 0xff, 0xff, 0xff, 0xf1, 0xff, 0xc5, 0xff,
- 0x7f, 0xfe, 0x2f, 0x00, 0xfe, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x11, 0xfe, 0xff, 0xff, 0xf5, 0xff,
- 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xfc, 0xff, 0x04, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x0c, 0xfc, 0xff, 0xff,
- 0xf4, 0xff, 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xfc, 0xff, 0x09, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x02, 0xfc,
- 0xff, 0x7f, 0xf2, 0xff, 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xf8, 0xff,
- 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x01,
- 0x00, 0xe0, 0xff, 0x3f, 0xf1, 0xff, 0x85, 0xff, 0x7f, 0xfe, 0x2f, 0x00,
- 0xf8, 0xff, 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff,
- 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x85, 0xff, 0x7f, 0xfe,
- 0x2f, 0x00, 0xf0, 0xff, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff,
- 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x85, 0xff,
- 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xf0, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x7f, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/lib/gs/contribs/bonk/bitmaps/bonkmiss b/lib/gs/contribs/bonk/bitmaps/bonkmiss
deleted file mode 100644
index 862e4839fc..0000000000
--- a/lib/gs/contribs/bonk/bitmaps/bonkmiss
+++ /dev/null
@@ -1,66 +0,0 @@
-#define bonkmiss_width 75
-#define bonkmiss_height 75
-static char bonkmiss_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x60, 0x80, 0x19, 0x3c, 0xc0, 0x83, 0xff, 0xf9, 0x01, 0x00, 0x60, 0x80,
- 0x19, 0x7e, 0xe0, 0x87, 0xff, 0xf9, 0x03, 0x00, 0xe0, 0xc0, 0x19, 0xe7,
- 0x70, 0x8e, 0x01, 0x18, 0x07, 0x00, 0xe0, 0xc0, 0x99, 0xc3, 0x39, 0x9c,
- 0x01, 0x18, 0x0e, 0x00, 0xe0, 0xe1, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18,
- 0x0c, 0x00, 0xe0, 0xe1, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x1c, 0x00,
- 0xe0, 0xf3, 0x99, 0x01, 0x18, 0x80, 0x01, 0x18, 0x18, 0x00, 0x60, 0xb3,
- 0x99, 0x01, 0x18, 0x80, 0x01, 0x18, 0x18, 0x00, 0x60, 0xb3, 0x99, 0x03,
- 0x38, 0x80, 0x01, 0x18, 0x18, 0x00, 0x60, 0x9e, 0x19, 0x07, 0x70, 0x80,
- 0x01, 0x18, 0x18, 0x00, 0x60, 0x9e, 0x19, 0x3e, 0xe0, 0x83, 0x1f, 0x18,
- 0x18, 0x00, 0x60, 0x8c, 0x19, 0x7c, 0xc0, 0x87, 0x1f, 0x18, 0x18, 0x00,
- 0x60, 0x80, 0x19, 0xe0, 0x00, 0x8e, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80,
- 0x19, 0xc0, 0x01, 0x9c, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x19, 0x80,
- 0x01, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x19, 0x80, 0x01, 0x98,
- 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x19, 0x80, 0x01, 0x98, 0x01, 0x18,
- 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x18, 0x00,
- 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80,
- 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x99, 0x81,
- 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98,
- 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18,
- 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x1c, 0x00,
- 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x0c, 0x00, 0x60, 0x80,
- 0x99, 0xc3, 0x39, 0x9c, 0x01, 0x18, 0x0e, 0x00, 0x60, 0x80, 0x19, 0xe7,
- 0x70, 0x8e, 0x01, 0x18, 0x07, 0x00, 0x60, 0x80, 0x19, 0x7e, 0xe0, 0x87,
- 0xff, 0xf9, 0x03, 0x00, 0x60, 0x80, 0x19, 0x3c, 0xc0, 0x83, 0xff, 0xf9,
- 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0xff, 0x03, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0xff, 0x03, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x1c, 0x38, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x1c, 0x38, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c,
- 0x3c, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, 0x3c, 0x03,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7c, 0x3e, 0x03, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x6c, 0x36, 0x03, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x6c, 0x36, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xcc, 0x33, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xcc,
- 0x33, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x8c, 0x31, 0x3f,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c,
- 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c,
- 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x0c, 0x30, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c,
- 0x30, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/lib/gs/contribs/bonk/bitmaps/bonktom b/lib/gs/contribs/bonk/bitmaps/bonktom
deleted file mode 100644
index defbc32cc9..0000000000
--- a/lib/gs/contribs/bonk/bitmaps/bonktom
+++ /dev/null
@@ -1,66 +0,0 @@
-#define bonktom_width 75
-#define bonktom_height 75
-static char bonktom_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/lib/gs/contribs/bonk/bitmaps/bonkx b/lib/gs/contribs/bonk/bitmaps/bonkx
deleted file mode 100644
index 70cd89bdb7..0000000000
--- a/lib/gs/contribs/bonk/bitmaps/bonkx
+++ /dev/null
@@ -1,66 +0,0 @@
-#define bonkx_width 75
-#define bonkx_height 75
-static char bonkx_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x3e, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0x7e, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xf0, 0x03, 0xfe, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xf8, 0x03, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01,
- 0xf8, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x00, 0xf0, 0x07,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0x00, 0xe0, 0x0f, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x80, 0x3f, 0x00, 0xc0, 0x1f, 0x00, 0x00, 0xfe, 0x03,
- 0x00, 0xc0, 0x1f, 0x00, 0x80, 0x3f, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0xe0,
- 0x0f, 0x00, 0x00, 0x7f, 0x00, 0x18, 0x00, 0xc0, 0x00, 0xf0, 0x07, 0x00,
- 0x00, 0xfe, 0x00, 0x06, 0x00, 0x00, 0x03, 0xf8, 0x03, 0x00, 0x00, 0xfc,
- 0x81, 0x01, 0x00, 0x00, 0x0c, 0xfc, 0x01, 0x00, 0x00, 0xf8, 0x43, 0x00,
- 0x00, 0x00, 0x10, 0xfe, 0x00, 0x00, 0x00, 0xf0, 0x27, 0x00, 0x00, 0x00,
- 0x20, 0x7f, 0x00, 0x00, 0x00, 0xe0, 0x1f, 0x00, 0x00, 0x00, 0xc0, 0x3f,
- 0x00, 0x00, 0x00, 0xc0, 0x1f, 0x00, 0x00, 0x00, 0xc0, 0x1f, 0x00, 0x00,
- 0x00, 0x80, 0x3f, 0x00, 0x00, 0x00, 0xe0, 0x0f, 0x00, 0x00, 0x00, 0x00,
- 0x7f, 0x00, 0x00, 0x00, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00, 0xff, 0x08,
- 0x00, 0x80, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00, 0xfd, 0x31, 0x00, 0x60,
- 0xfc, 0x05, 0x00, 0x00, 0x00, 0x80, 0xf8, 0xc3, 0x00, 0x18, 0xfe, 0x08,
- 0x00, 0x00, 0x00, 0x80, 0xf7, 0x07, 0x03, 0x06, 0x7f, 0x0f, 0x00, 0x00,
- 0x00, 0x40, 0xff, 0x0f, 0x00, 0x80, 0xff, 0x17, 0x00, 0x00, 0x00, 0x40,
- 0xfe, 0x1f, 0x00, 0xc0, 0xff, 0x13, 0x00, 0x00, 0x00, 0x20, 0xf8, 0xff,
- 0x03, 0xfe, 0xff, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0xff, 0xff,
- 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xc0, 0xff, 0xdf, 0xff, 0x1f, 0x20,
- 0x00, 0x00, 0x00, 0x20, 0x00, 0xff, 0xdf, 0xff, 0x07, 0x20, 0x00, 0x00,
- 0x00, 0x10, 0x00, 0xfe, 0x8f, 0xff, 0x03, 0x40, 0x00, 0x00, 0x00, 0x10,
- 0x00, 0xf8, 0x8f, 0xff, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xf0,
- 0x8f, 0x7f, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xc0, 0xdf, 0x1f,
- 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0x80, 0xff, 0x0f, 0x00, 0x40,
- 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0xff, 0x07, 0x00, 0x40, 0x00, 0x00,
- 0x00, 0x10, 0x00, 0x00, 0xfe, 0x03, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10,
- 0x00, 0x00, 0xfc, 0x01, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xe0,
- 0xfe, 0x3b, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0xf0, 0xff, 0x7f,
- 0x40, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0x80, 0xff, 0x0f, 0x40, 0x40,
- 0x00, 0x00, 0x00, 0x10, 0x10, 0xc0, 0xff, 0x1f, 0x40, 0x40, 0x00, 0x00,
- 0x00, 0x10, 0x30, 0xe0, 0x8f, 0x3f, 0x60, 0x40, 0x00, 0x00, 0x00, 0x10,
- 0x70, 0xf0, 0x07, 0x7f, 0x70, 0x40, 0x00, 0x00, 0x00, 0x10, 0xf0, 0xf9,
- 0x03, 0xfe, 0x7c, 0x40, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0x01, 0xfc,
- 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0x03, 0xfe, 0x7f, 0x20,
- 0x00, 0x00, 0x00, 0x20, 0xf0, 0x7f, 0xfe, 0xff, 0x7f, 0x20, 0x00, 0x00,
- 0x00, 0x20, 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x20, 0x00, 0x00, 0x00, 0x40,
- 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x10, 0x00, 0x00, 0x00, 0x40, 0xe0, 0xff,
- 0xff, 0xff, 0x3f, 0x10, 0x00, 0x00, 0x00, 0x80, 0xf0, 0xff, 0xff, 0xff,
- 0x7f, 0x08, 0x00, 0x00, 0x00, 0x80, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x08,
- 0x00, 0x00, 0x00, 0x00, 0xfd, 0xff, 0xff, 0xff, 0xff, 0x05, 0x00, 0x00,
- 0x00, 0x00, 0xff, 0xfe, 0xff, 0xff, 0xfb, 0x07, 0x00, 0x00, 0x00, 0x00,
- 0x7f, 0xfc, 0xff, 0xfc, 0xf1, 0x07, 0x00, 0x00, 0x00, 0x80, 0x3f, 0xf0,
- 0xff, 0x7c, 0xe0, 0x0f, 0x00, 0x00, 0x00, 0xc0, 0x1f, 0xc0, 0xff, 0x1c,
- 0xc0, 0x1f, 0x00, 0x00, 0x00, 0xe0, 0x1f, 0x00, 0xff, 0x07, 0xc0, 0x3f,
- 0x00, 0x00, 0x00, 0xf0, 0x27, 0x00, 0x00, 0x00, 0x20, 0x7f, 0x00, 0x00,
- 0x00, 0xf8, 0x43, 0x00, 0x00, 0x00, 0x10, 0xfe, 0x00, 0x00, 0x00, 0xfc,
- 0x81, 0x01, 0x00, 0x00, 0x0c, 0xfc, 0x01, 0x00, 0x00, 0xfe, 0x00, 0x06,
- 0x00, 0x00, 0x03, 0xf8, 0x03, 0x00, 0x00, 0x7f, 0x00, 0x18, 0x00, 0xc0,
- 0x00, 0xf0, 0x07, 0x00, 0x80, 0x3f, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0xe0,
- 0x0f, 0x00, 0xc0, 0x1f, 0x00, 0x00, 0xfe, 0x03, 0x00, 0xc0, 0x1f, 0x00,
- 0xe0, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x3f, 0x00, 0xf0, 0x07,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0x00, 0xf8, 0x03, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xfe, 0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xfc, 0x01, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xf8, 0x03, 0x7e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x03,
- 0x3e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0x1e, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/lib/gs/contribs/bonk/bitmaps/erl-e b/lib/gs/contribs/bonk/bitmaps/erl-e
deleted file mode 100644
index 41ad14f404..0000000000
--- a/lib/gs/contribs/bonk/bitmaps/erl-e
+++ /dev/null
@@ -1,106 +0,0 @@
-#define erl-e_width 108
-#define erl-e_height 88
-static char erl-e_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0xfc, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xe0, 0xff, 0xf7, 0xfc, 0xff, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf7, 0xfc, 0x7f, 0x00, 0x00,
- 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0x00, 0x80, 0xff, 0xf7, 0xfc, 0x3f,
- 0x00, 0x00, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xff, 0xf7,
- 0xfc, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00,
- 0xff, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0x00, 0x00,
- 0x00, 0x00, 0xfe, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff,
- 0x01, 0x00, 0x00, 0x00, 0xfe, 0xf7, 0xfc, 0x0f, 0x00, 0x00, 0x00, 0xe0,
- 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0xfc, 0xf7, 0xfc, 0x0f, 0x00, 0x00,
- 0x00, 0xf0, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0xfc, 0xf7, 0xfc, 0x07,
- 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0xf8, 0xf7,
- 0xfc, 0x07, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00,
- 0xf8, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x0f, 0x00,
- 0x00, 0x00, 0xf8, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff,
- 0x0f, 0x00, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x01, 0x00, 0x00, 0x00, 0xfc,
- 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x01, 0x00, 0x00,
- 0x00, 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x00,
- 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0xf0, 0xf7,
- 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xf0, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xe0, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x7c, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x7c, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x7c, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7,
- 0x7c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7,
- 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xc0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xc0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xf7, 0x3c, 0x00, 0x00, 0x00,
- 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00,
- 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7,
- 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00,
- 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00,
- 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7,
- 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x7c, 0x00, 0x00, 0x00,
- 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x7c, 0x00,
- 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7,
- 0x7c, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xf7, 0x7c, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff,
- 0x7f, 0xfe, 0xff, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff,
- 0xff, 0xff, 0x3f, 0xf8, 0xff, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0xf8,
- 0xff, 0xff, 0xff, 0xff, 0x3f, 0xe0, 0xff, 0xf7, 0xfc, 0x00, 0x00, 0x00,
- 0x00, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x1f, 0xc0, 0xff, 0xf7, 0xfc, 0x01,
- 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0xfe, 0xf7,
- 0xfc, 0x01, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00,
- 0xf8, 0xf7, 0xfc, 0x01, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff,
- 0x03, 0x00, 0xe0, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff,
- 0xff, 0xff, 0x03, 0x00, 0xc0, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xc0,
- 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x80, 0xf7, 0xfc, 0x07, 0x00, 0x00,
- 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x80, 0xf7, 0xfc, 0x07,
- 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x80, 0xf7,
- 0xfc, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x1f, 0x00, 0x00,
- 0xc0, 0xf7, 0xfc, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x0f,
- 0x00, 0x00, 0xe0, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff,
- 0xff, 0x07, 0x00, 0x00, 0xe0, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x00,
- 0xf0, 0xff, 0xff, 0x03, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x3f, 0x00, 0x00,
- 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0x00, 0x00, 0xf8, 0xf7, 0xfc, 0x7f,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x1f, 0x00, 0x00, 0x00, 0xfc, 0xf7,
- 0xfc, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xfc, 0xf7, 0xfc, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xfe, 0xf7, 0xfc, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xff, 0xf7, 0xfc, 0xff, 0x03, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xf7, 0xfc, 0xff, 0x07, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf7, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0};
diff --git a/lib/gs/contribs/bonk/bitmaps/erl-text b/lib/gs/contribs/bonk/bitmaps/erl-text
deleted file mode 100644
index e20a9e5a28..0000000000
--- a/lib/gs/contribs/bonk/bitmaps/erl-text
+++ /dev/null
@@ -1,106 +0,0 @@
-#define erl-text_width 108
-#define erl-text_height 88
-static char erl-text_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
- 0xfc, 0x03, 0xf8, 0x00, 0x70, 0x00, 0x80, 0x03, 0x80, 0x03, 0x07, 0x00,
- 0x3e, 0xf0, 0xfc, 0x03, 0xf8, 0x03, 0x70, 0x00, 0x80, 0x03, 0x80, 0x07,
- 0x07, 0x80, 0xff, 0xf0, 0xfc, 0x03, 0xf8, 0x07, 0x70, 0x00, 0xc0, 0x07,
- 0x80, 0x07, 0x07, 0xe0, 0xff, 0xf1, 0x1c, 0x00, 0x38, 0x07, 0x70, 0x00,
- 0xc0, 0x07, 0x80, 0x0f, 0x07, 0xe0, 0xc1, 0xf3, 0x1c, 0x00, 0x38, 0x0e,
- 0x70, 0x00, 0xe0, 0x0f, 0x80, 0x1f, 0x07, 0xf0, 0x80, 0xf3, 0x1c, 0x00,
- 0x38, 0x0f, 0x70, 0x00, 0xe0, 0x0e, 0x80, 0x1f, 0x07, 0x78, 0x00, 0xf0,
- 0xfc, 0x03, 0xf8, 0x07, 0x70, 0x00, 0xe0, 0x0e, 0x80, 0x3f, 0x07, 0x78,
- 0x00, 0xf0, 0xfc, 0x03, 0xf8, 0x03, 0x70, 0x00, 0x70, 0x1c, 0x80, 0x7b,
- 0x07, 0x38, 0x00, 0xf0, 0xfc, 0x03, 0xf8, 0x01, 0x70, 0x00, 0x70, 0x1c,
- 0x80, 0xf3, 0x07, 0x38, 0xf8, 0xf7, 0x1c, 0x00, 0xf8, 0x01, 0x70, 0x00,
- 0x70, 0x1c, 0x80, 0xe3, 0x07, 0x78, 0xf8, 0xf7, 0x1c, 0x00, 0xf8, 0x03,
- 0x70, 0x00, 0xf8, 0x3f, 0x80, 0xe3, 0x07, 0x70, 0x80, 0xf7, 0x1c, 0x00,
- 0xb8, 0x03, 0x70, 0x00, 0xf8, 0x3f, 0x80, 0xc3, 0x07, 0xf0, 0x80, 0xf3,
- 0xfc, 0x03, 0x38, 0x07, 0xf0, 0x07, 0x38, 0x38, 0x80, 0x83, 0x07, 0xe0,
- 0xe3, 0xf3, 0xfc, 0x03, 0x38, 0x07, 0xf0, 0x07, 0x1c, 0x70, 0x80, 0x83,
- 0x07, 0xc0, 0xff, 0xf1, 0xfc, 0x03, 0x38, 0x0e, 0xf0, 0x07, 0x1c, 0x70,
- 0x80, 0x03, 0x07, 0x00, 0x7f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0};
diff --git a/lib/gs/contribs/bonk/bonk.erl b/lib/gs/contribs/bonk/bonk.erl
deleted file mode 100644
index bbbc656b34..0000000000
--- a/lib/gs/contribs/bonk/bonk.erl
+++ /dev/null
@@ -1,584 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(bonk).
--compile([{nowarn_deprecated_function,{gs,config,2}},
- {nowarn_deprecated_function,{gs,create,3}},
- {nowarn_deprecated_function,{gs,create,4}},
- {nowarn_deprecated_function,{gs,destroy,1}},
- {nowarn_deprecated_function,{gs,start,0}}]).
-
--export([run/0, run/1,bonk_dir/0,start/0]).
-
--record(colors, {miss, x, bomb, face}).
--record(scores, {points, level, bombs, hits, showed, bonus}).
-
-start() ->
- spawn(bonk, run, []).
-
-run() ->
- run(color).
-
-run([ColorMode]) -> % This is for the start script...
- run(ColorMode);
-
-run(ColorMode) when is_atom(ColorMode) ->
- GS = gs:start(),
- SoundPid = spawn_link(bonk_sound,start,[]),
- {H,M,S} = time(),
- random:seed(H*13,M*7,S*3),
- {SqrPids, Bmps, Colors} = create_board(GS, ColorMode),
- {ScoreL,_File} = get_highscore(),
- display_highscore(ScoreL),
- put(colormode, ColorMode),
- SoundPid ! music,
- sleep(6500),
- gs:config(aboutButton, [{enable,true}]),
- gs:config(newButton, [{enable,true}]),
- gs:config(quitButton, [{enable,true}]),
- idle(SoundPid, SqrPids, Bmps, Colors).
-
-%% This is not an application so we don't have their way of knowing
-%% a private data directory where the GIF files are located (this directory).
-%% We can find GS and makes it relative from there /kgb
-%%
-%% Note the silly slash that is added. The rest of the code uses
-%% append to contruct file names and assumes that the directory ends
-%% in slash. If filename:join was used and the problem is gone.
-
--define(EbinFromGsPriv,"../contribs/bonk").
-
-bonk_dir() ->
- GsPrivDir = code:priv_dir(gs),
- filename:join(GsPrivDir,?EbinFromGsPriv) ++ "/".
-
-
-idle(SoundPid, SqrPids, Bmps, Colors) ->
- receive
- {gs, newButton, click, _Data, _Args} ->
- init(SoundPid, SqrPids, Bmps, Colors);
- {gs, aboutButton, click, _Data, _Args} ->
- display_about(),
- idle(SoundPid, SqrPids, Bmps, Colors);
- {gs, quitButton, click, _Data, _Args} ->
- SoundPid ! quit,
- send_to_all(SqrPids, quit);
- _Other ->
- %%io:format("Got ~w in idle~n", [_Other]),
- idle(SoundPid, SqrPids, Bmps, Colors)
- end.
-
-
-
-init(SoundPid, SqrPids, Bmps, Colors) ->
- clear_board(Bmps),
- SoundPid ! start,
- gs:config(newButton, [{enable,false}]),
- gs:config(endButton, [{enable,true}]),
- gs:config(aboutButton, [{enable,false}]),
- Scores = #scores{points=0, level=1, bombs=0, hits=0, showed=0, bonus=10},
- clear_scores(Scores),
- flush(),
- send_to_all(SqrPids, start),
- game(SoundPid, SqrPids, Bmps, Colors, Scores).
-
-
-game(SoundPid, SqrPids, Bmps, Colors, Scores) ->
- receive
- {gs, _Square, buttonpress, SqrPid, [1 | _Rest]} when is_pid(SqrPid) ->
- SqrPid ! bonk,
- game(SoundPid, SqrPids, Bmps, Colors, Scores);
- {gs, _Id, buttonpress, _Data, [Butt | _Rest]} when Butt =/= 1 ->
- NewScores = bomb(SoundPid, SqrPids, Scores),
- game(SoundPid, SqrPids, Bmps, Colors, NewScores);
- {show, Square, Rect} ->
- NewScores = show_face(Square, Rect, Colors, Scores),
- game(SoundPid, SqrPids, Bmps, Colors, NewScores);
- {hide, Square, Rect} ->
- NewScores = hide_face(Square, Rect, Colors, Scores),
- game(SoundPid, SqrPids, Bmps, Colors, NewScores);
- {missed, Square, Rect} ->
- case miss_face(SoundPid, Square, Rect, Colors, Scores) of
- {continue, NewScores} ->
- game(SoundPid, SqrPids, Bmps, Colors, NewScores);
- {game_over, NewScores} ->
- game_over(SoundPid, SqrPids, Bmps, Colors, NewScores)
- end;
- {bonked, Square, Rect} ->
- NewScores = bonked(SoundPid, SqrPids, Square, Rect, Scores, Colors),
- game(SoundPid, SqrPids, Bmps, Colors, NewScores);
- {bombed, Square, Rect} ->
- NewScores = bombed(SoundPid, SqrPids, Square, Rect, Scores, Colors),
- game(SoundPid, SqrPids, Bmps, Colors, NewScores);
- {gs, endButton, click, _Data, _Args} ->
- game_over(SoundPid, SqrPids, Bmps, Colors, Scores);
- {gs, quitButton, click, _Data, _Args} ->
- quit(SoundPid, SqrPids, Bmps, Colors, Scores);
- _Other ->
- game(SoundPid, SqrPids, Bmps, Colors, Scores)
- end.
-
-
-
-game_over(SoundPid, SqrPids, Bmps, Colors, Scores) ->
- SoundPid ! game_over,
- send_to_all(SqrPids, stop),
- flush(),
- sleep(2000),
- update_scorelist(SoundPid, Scores),
- gs:config(newButton, [{enable,true}]),
- gs:config(endButton, [{enable,false}]),
- gs:config(aboutButton, [{enable,true}]),
- idle(SoundPid, SqrPids, Bmps, Colors).
-
-
-quit(SoundPid, SqrPids, _Bmps, _Colors, _Scores) ->
- SoundPid ! quit,
- send_to_all(SqrPids, quit),
- true.
-
-
-
-bomb(SoundPid, SqrPids, Scores) ->
- case Scores#scores.bombs of
- Bombs when Bombs > 0 ->
- send_to_all(SqrPids, bomb),
- SoundPid ! bomb,
- gs:config(bombOut,[{text,integer_to_list(Bombs-1)}]),
- Scores#scores{bombs=Bombs-1};
- _Other ->
- Scores
- end.
-
-show_face(Square, Rect, Colors, Scores) ->
- Showed = Scores#scores.showed,
- if
- Showed == Scores#scores.level+1 ->
- Square ! sleep,
- Scores;
- true ->
- FaceColors = Colors#colors.face,
- FaceColor = lists:nth(random:uniform(length(FaceColors)), FaceColors),
- gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkface")},{fg, FaceColor}]),
- Scores#scores{showed=Showed+1}
- end.
-
-hide_face(_Square, Rect, _Colors, Scores) ->
- Showed = Scores#scores.showed,
- gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonktom")}]),
- Scores#scores{showed=Showed-1}.
-
-
-miss_face(SoundPid, _Square, Rect, Colors, Scores) ->
- SoundPid ! missed,
- gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkmiss")}, {fg, Colors#colors.miss}]),
- Bonus = Scores#scores.bonus,
- if
- Bonus > 1 ->
- gs:config(bonusOut, [{text,integer_to_list(Bonus-1)}]),
- {continue, Scores#scores{bonus=Bonus-1}};
- true ->
- gs:config(bonusOut, [{text,"0"}]),
- {game_over, Scores}
- end.
-
-bonked(SoundPid, SqrPids, _Square, Rect, Scores, Colors) ->
- gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkx")}, {fg, Colors#colors.x}]),
- SoundPid ! bonk,
- update_score(SoundPid, SqrPids, Scores).
-
-bombed(SoundPid, SqrPids, _Square, Rect, Scores, Colors) ->
- gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkbomb")}, {fg, Colors#colors.bomb}]),
- update_score(SoundPid, SqrPids, Scores).
-
-
-update_score(SoundPid, SqrPids, Scores) ->
- Points = Scores#scores.points,
- Level = Scores#scores.level,
- NewPoints = Points+Level,
- gs:config(scoreOut,[{text,integer_to_list(NewPoints)}]),
- case Scores#scores.hits of
- 24 ->
- SoundPid ! new_level,
- NewLevel = Level+1,
- NewBombs = Scores#scores.bombs+1,
- send_to_all(SqrPids, {new_level, NewLevel}),
- gs:config(levelOut,[{text,integer_to_list(NewLevel)}]),
- gs:config(bombOut,[{text,integer_to_list(NewBombs)}]),
- Scores#scores{points=NewPoints, level=NewLevel, hits=0, bombs=NewBombs};
- Hits ->
- Scores#scores{points=NewPoints, hits=Hits+1}
- end.
-
-
-send_to_all([], _Msg) ->
- true;
-send_to_all([Pid|Rest],Msg) when is_pid(Pid) ->
- Pid ! Msg,
- send_to_all(Rest,Msg);
-send_to_all([_Else|Rest],Msg) ->
- send_to_all(Rest,Msg).
-
-
-create_board(GS, ColorMode) ->
- Colors =
- case ColorMode of
- bw -> #colors{miss=white, x=white, bomb=white, face=[white]};
- _Color -> #colors{miss=red, x=green, bomb=white,
- face=[lightblue, orange, magenta, peachpuff, pink]}
- end,
- BGCol = if ColorMode==bw -> black; true -> black end, % background color
- TextCol = if ColorMode==bw -> white; true -> pink end, % status texts
- NrCol = if ColorMode==bw -> white; true -> purple end, % status figures
- LogoCol = if ColorMode==bw -> white; true -> green end, % bonk logo
- BLineCol = if ColorMode==bw -> white; true -> grey end, % button line
- SLineCol = if ColorMode==bw -> white; true -> red end, % status line
- BTextCol = if ColorMode==bw -> white; true -> orange end, % button text
- HiHeadCol = if ColorMode==bw -> white; true -> red end, % high score label
- HiCol = if ColorMode==bw -> white; true -> cyan end, % high scores
- SquareCol = if ColorMode==bw -> white; true -> yellow end, % game squares
- ErlFgCol = if ColorMode==bw -> white; true -> red end, %
- ErlBGCol = if ColorMode==bw -> black; true -> white end, %
- ErlTxtCol = if ColorMode==bw -> white; true -> black end, %
-
- Width = 550, % width of bonk window
- Height = 550, % Height of bonk window
-
- BX = 0, % x-pos for first button
- DBX = 100, % space between buttons
- BY = 0, % y-pos for buttons
- BLineY = 30, % y-pos of button line
- LogoX = (Width-320) div 2, % x-pos of bonk logo (logo is 320 pix wide)
- LogoY = BLineY+2, % y-pos of bonk logo
- ErlLogoX = LogoX + 200, % x-pos of Erlang e
- ErlLogoY = LogoY + 10, % y-pos of Erlang e
- SLineY = Height-22, % status line position
- TextWidth = 50, % text width of status items
- SX = 2, % x-pos for first status item
- DSX = TextWidth+94, % pixels between status items
- SY = SLineY+2, % y-pos status items
- HiWidth = 100, % width of high score field
- _HiHeight = 180, % height of the same
- HiX = Width-HiWidth, % high score text position
- HiY = BLineY+10,
- DHY = 20, % space between title & scores
- SquareSize = 76, % size of each game square
- SquareSpace = 1, % space between game squares
- SquareX = 40,
- SquareY = 65,
-
- gs:create(window, bonkWin, GS, [{width, Width}, {height, Height},
- {bg, BGCol},
- {title, "Bonk the game"},
- {iconname, "Bonk!"},
- {map, false}]),
- gs:create(canvas, bonkCanvas, bonkWin, [{width, Width},
- {height, Height},
- {bg, BGCol}]),
- gs:create(image, bonkCanvas, [{bitmap,lists:append(bonk_dir(), "bitmaps/bonklogo")},
- {coords, [{LogoX, LogoY}]},
- {fg, LogoCol},
- {bg, BGCol}]),
- gs:create(image, bonkCanvas, [{bitmap,lists:append(bonk_dir(), "bitmaps/erl-e")},
- {coords, [{ErlLogoX, ErlLogoY}]},
- {fg, ErlFgCol},
- {bg, ErlBGCol}]),
- gs:create(image, bonkCanvas, [{bitmap,lists:append(bonk_dir(), "bitmaps/erl-text")},
- {coords, [{ErlLogoX, ErlLogoY}]},
- {fg, ErlTxtCol}]),
- gs:create(line, bLine, bonkCanvas, [{coords, [{0,BLineY}, {Width,BLineY}]},
- {fg, BLineCol},
- {width, 2}]),
- gs:create(line, bLine, bonkCanvas, [{coords, [{0,SLineY}, {Width, SLineY}]},
- {fg, SLineCol},
- {width, 2}]),
- gs:create(text, scoreText, bonkCanvas, [{coords, [{SX, SY}]},
- {fg, TextCol},
- {text, "Score:"}]),
- gs:create(text, scoreOut, bonkCanvas, [{coords, [{SX+TextWidth, SY}]},
- {fg, NrCol},
- {width, DSX-TextWidth},
- {text, ""}]),
- gs:create(text, bombText, bonkCanvas, [{coords, [{SX+DSX, SY}]},
- {fg, TextCol},
- {text, "Bombs:"}]),
- gs:create(text, bombOut, bonkCanvas, [{coords, [{SX+DSX+TextWidth, SY}]},
- {fg, NrCol},
- {width, DSX-TextWidth},
- {text, ""}]),
- gs:create(text, bonusText, bonkCanvas, [{coords, [{SX+2*DSX, SY}]},
- {fg, TextCol},
- {text, "Bonus:"}]),
- gs:create(text, bonusOut, bonkCanvas, [{coords, [{SX+2*DSX+TextWidth, SY}]},
- {fg, NrCol},
- {width, DSX-TextWidth},
- {text, ""}]),
- gs:create(text, levelText,bonkCanvas, [{coords, [{SX+3*DSX, SY}]},
- {fg, TextCol},
- {text, "Level:"}]),
- gs:create(text, levelOut, bonkCanvas, [{coords, [{SX+3*DSX+TextWidth, SY}]},
- {fg, NrCol},
- {width, DSX-TextWidth},
- {text, ""}]),
- gs:create(text, hiScoreText, bonkCanvas, [{coords, [{HiX, HiY}]},
- {fg, HiHeadCol},
- {text, "High Scores"}]),
- gs:create(text, hiScoreOut, bonkCanvas, [{coords, [{HiX, HiY+DHY}]},
- {fg, HiCol},
- {justify, left},
- {width, HiWidth}]),
- gs:create(button, newButton,bonkWin, [{x, BX},{y, BY},
- {enable,false},
- {label, {text, "New Game"}},
- {click, true},
- {fg, BTextCol},
- {bg, BGCol},
- {relief, flat},
- {activefg, BTextCol},
- {activebg, BGCol},
- {align, center}]),
- gs:create(button, endButton,bonkWin, [{x, BX+DBX},{y, BY},
- {enable,false},
- {label, {text, "End Game"}},
- {click, true},
- {fg, BTextCol},
- {bg, BGCol},
- {relief, flat},
- {activefg, BTextCol},
- {activebg, BGCol},
- {align, center}]),
- gs:create(button, aboutButton,bonkWin, [{x, BX+2*DBX},{y, BY},
- {enable,false},
- {label, {text, "About"}},
- {click, true},
- {fg, BTextCol},
- {bg, BGCol},
- {relief, flat},
- {activefg, BTextCol},
- {activebg, BGCol},
- {align, center}]),
- gs:create(button, quitButton, bonkWin, [{x, BX+3*DBX},{y, BY},
- {enable,false},
- {label, {text, "Quit"}},
- {click, true},
- {fg, BTextCol},
- {bg, BGCol},
- {relief, flat},
- {activefg, BTextCol},
- {activebg, BGCol},
- {align, center}]),
-
- {SqrPids, Bmps} =
- create_squares(SquareX, SquareY, SquareSize, SquareCol, SquareSpace),
- gs:config(bonkWin, [{map, true}]),
- {SqrPids, Bmps, Colors}.
-
-
-
-create_squares(X, Y, Size, Color, Spc) ->
- create_squares(X, Y, Size, Color, Spc, 1, 1, [], []).
-
-
-create_squares(_X, _Y, _Size, _Color, _Spc, 4, 5, Pids, Bmps) ->
- {Pids, Bmps};
-
-create_squares(X, Y, Size, Color, Spc, Row, 5, Pids, Bmps) ->
- create_squares(X, Y, Size, Color, Spc, Row+1, 1, Pids, Bmps);
-
-create_squares(X, Y, Size, Color, Spc, Row, Col, Pids, Bmps) ->
- Xpos = X+Col*Size+(Col-1)*Spc,
- Ypos = Y+Row*Size+(Row-1)*Spc,
- gs:create(rectangle, bonkCanvas,
- [{coords, [{Xpos,Ypos},{Xpos+Size, Ypos+Size}]},
- {bw, 2},{fg, Color},{buttonpress,true}]),
- Bmp = gs:create(image, bonkCanvas,
- [{coords, [{Xpos+1, Ypos+1}]},
- {bitmap,lists:append(bonk_dir(), "bitmaps/bonktom")},
- {buttonpress, true},{fg, Color}]),
- Pid = bonk_square:start(Bmp),
- gs:config(Bmp, [{data, Pid}]),
- create_squares(X, Y, Size, Color, Spc, Row, Col+1, [Pid|Pids], [Bmp|Bmps]).
-
-
-
-clear_board([]) ->
- true;
-clear_board([Square | Rest]) ->
- gs:config(Square, [{bitmap,lists:append(bonk_dir(), "bitmaps/bonktom")}]),
- clear_board(Rest).
-
-
-%% Prints the list on the screen.
-%% The list is on the form [[Score,Name],[Score,Name]..].
-
-display_highscore(ScoreList) ->
- display_highscore("",ScoreList,0).
-
-display_highscore(Scores,[],_N) ->
- gs:config(hiScoreOut,[{text,Scores}]);
-
-display_highscore(Scores,_ScoreList,10) -> % This is max number of items.
- display_highscore(Scores,[], 10);
-
-display_highscore(Scores,[[Score,Name]|Rest],N) ->
- NewScores = lists:append(Scores,lists:append(lists:append(Score, [32 | Name]), [10])),
- display_highscore(NewScores,Rest,N+1).
-
-
-%% Reads the highscorelist from the file "bonk.score".
-%% The list should be an sorted erlang-list.
-
-get_highscore() ->
- case file:consult("bonk.score") of
- {ok,[Score_list]} ->
- {Score_list,"./bonk.score"};
- {error,_} ->
- {[],"./bonk.score"}
- end.
-
-
-%% Prints out the highscorelist and places the new score in the
-%% list if it is high enough.
-
-update_scorelist(SoundPid, Scores) ->
- case Scores#scores.points of
- 0 -> true;
- Score ->
- {ScoreL,FileName} = get_highscore(),
- New_scorelist=update_scorelist_2(ScoreL, Score, 0, SoundPid),
- display_highscore(New_scorelist),
- case file:open(FileName, [write]) of
- {error,_} ->
- true;
- {ok,FD} ->
- io:format(FD,"~w~s~n",[New_scorelist,"."]),
- file:close(FD)
- end
- end.
-
-
-update_scorelist_2([], Score, N, _SoundPid) when N < 10 ->
- [[integer_to_list(Score),getuser()]];
-
-update_scorelist_2(_, _, N, _SoundPid) when N >= 10 ->
- [];
-
-update_scorelist_2([[Sc, Name] | Rest], Score, N, SoundPid) ->
- case list_to_integer(Sc) of
- Sc_int when Sc_int < Score ->
- if
- N == 0 -> SoundPid ! best_score;
- true -> SoundPid ! high_score
- end,
- lists:append([[integer_to_list(Score),getuser()]],
- update_scorelist_3([[Sc,Name]|Rest],N+1));
- _Other ->
- lists:append([[Sc,Name]],update_scorelist_2(Rest, Score, N+1, SoundPid))
- end.
-
-
-update_scorelist_3([],_) ->
- [];
-
-update_scorelist_3(_,N) when N >= 10 ->
- [];
-
-update_scorelist_3([Item|Rest],N) ->
- lists:append([Item],update_scorelist_3(Rest,N+1)).
-
-getuser() ->
- case os:type() of
- {unix,_} ->
- lists:delete(10,os:cmd("whoami"));
- _ ->
- "Unknown"
- end.
-
-%% Prints out the initial values of scores, bonus, level and bombs.
-
-clear_scores(Scores) ->
- Score = integer_to_list(Scores#scores.points),
- Bombs = integer_to_list(Scores#scores.bombs),
- Bonus = integer_to_list(Scores#scores.bonus),
- Level = integer_to_list(Scores#scores.level),
- gs:config(scoreOut,{text,Score}),
- gs:config(bombOut,{text,Bombs}),
- gs:config(bonusOut,{text,Bonus}),
- gs:config(levelOut,{text,Level}).
-
-
-%% Removes everything that is present in the message-que.
-
-flush() ->
- receive
- _X ->
- flush()
- after
- 0 ->
- true
- end.
-
-sleep(X) ->
- receive after X -> true end.
-
-%% Opens a window and shows the contents of the file: "bonk.txt".
-%% The window will be removed before the function ends.
-
-display_about() ->
- {BGColor,TextColor,Bfg} =
- case get(colormode) of
- bw -> {black, white, white};
- _Color -> {black, peachpuff1, orange}
- end,
- Wid = 500, Hei = 635,
- GS = gs:start(),
- gs:create(window, aboutWin, GS, [{width, Wid}, {height,Hei},
- {map, false},
- {bg, BGColor},
- {title, "About Bonk!"}]),
- gs:create(canvas, aboutCan, aboutWin, [{width, Wid},{height, Hei},
- {bg, black}]),
- gs:create(button, okButton, aboutWin, [{x, Wid div 2 - 50},{y, Hei - 40},
- {label,{text, "Ok"}}, {click, true},
- {fg, Bfg}, {bg, BGColor},
- {relief, flat},
- {activefg, Bfg},
- {activebg, BGColor}]),
- gs:create(text, aboutText, aboutCan, [{width, Wid-30}, {coords, [{15, 0}]},
- {fg, TextColor}, {justify, center}]),
- case file:open(lists:append(bonk_dir(),"bonk.txt"), [read]) of
- {ok, Fd} ->
- write_text(Fd, "", io:get_line(Fd, "")),
- file:close(Fd);
- {error, _Reason} ->
- gs:config(aboutText, {text, "Error: could not read the about file"})
- end,
-
- gs:config(aboutWin, [{map,true}]),
- receive
- {gs, okButton, click, _, _} ->
- gs:destroy(aboutWin)
- end.
-
-write_text(_Fd, Text, eof) ->
- gs:config(aboutText, {text, Text});
-write_text(Fd, Text, More) ->
- write_text(Fd, lists:append(Text, More), io:get_line(Fd, "")).
diff --git a/lib/gs/contribs/bonk/bonk.gif b/lib/gs/contribs/bonk/bonk.gif
deleted file mode 100644
index 3c2299686b..0000000000
--- a/lib/gs/contribs/bonk/bonk.gif
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/bonk.tool b/lib/gs/contribs/bonk/bonk.tool
deleted file mode 100644
index 79ad8f6701..0000000000
--- a/lib/gs/contribs/bonk/bonk.tool
+++ /dev/null
@@ -1,6 +0,0 @@
-{version,"0.1"}.
-{{tool,"Bonk"},
- {start,{bonk,start,[]}},
- {icon,"bonk.gif"},
- {message,"Bonk - The Game"},
- {html,"../bonk/bonk.txt"}}.
diff --git a/lib/gs/contribs/bonk/bonk.txt b/lib/gs/contribs/bonk/bonk.txt
deleted file mode 100644
index 69c912dbee..0000000000
--- a/lib/gs/contribs/bonk/bonk.txt
+++ /dev/null
@@ -1,30 +0,0 @@
-BONK! In Erlang for You
-by
-LENNART OHMAN & MARCUS ARENDT
-
-After an idea of Mike Darweesh.
-Special thanks to Peter Jansson for creating the bitmaps.
-Ported to GS 1.1 by Markus Torpvret and Anders Dahlin.
-
-
-INSTRUCTIONS
-- Hit as many creatures as possible using the left mouse-button.
-- After every 25 hits You will advance one level. For each level You get one bomb.
-- Pushing the middle or right mouse-button, in any square, drops a bomb which
-wipes out everything.
-- The game ends when 10 creatures has escaped from beeing bonked.
-
-
-ABOUT ERLANG
-Erlang is a programming language for building robust concurrent systems. It is a single assignment, symbolic language with built in concurrency. It provides unique facilities for error handling and for reloading updated modules in running systems. Erlang was designed and implemented by Joe Armstrong, Robert Virding, and Mike Williams at Ellemtel (now Ericsson Utvecklings AB).
-
-Please make enquiries about Erlang to:
-
-Ericsson Software Technology AB
-Erlang Systems
-Torshamnsgatan 39B
-Box 1214
-164 28 Kista
-Sweden
-
-http://www.ericsson.se/erlang \ No newline at end of file
diff --git a/lib/gs/contribs/bonk/bonk_sound.erl b/lib/gs/contribs/bonk/bonk_sound.erl
deleted file mode 100644
index 9a0db80e5d..0000000000
--- a/lib/gs/contribs/bonk/bonk_sound.erl
+++ /dev/null
@@ -1,82 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(bonk_sound).
--export([start/0]).
-
-start() ->
- random:seed(),
- sounder:start(),
- {ok,Bonk}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/bonk.au")),
- {ok,Ouch}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/ouch!!!.au")),
- {ok,Damn}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/damn.au")),
- {ok,Bomb}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/explosion.au")),
- {ok,Missed}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/missedme.au")),
- {ok,Game_over}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/gameover.au")),
- {ok,New_level}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/level.au")),
- {ok,Music}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/trumpet.au")),
- {ok,Start}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/hehee.au")),
- {ok,BestS}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/praisejesus.au")),
- {ok,HighS}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/yes.au")),
- loop(Bonk, Ouch, Damn, Bomb, Missed, Game_over, New_level,
- Music, Start, BestS, HighS).
-
-
-loop(Bonk, Ouch, Damn, Bomb, Missed, Game_over, New_level, Music, Start, BestS, HighS) ->
- R=random:uniform(1000),
- receive
- bonk ->
- if
- R < 75 -> play_sound(Damn);
- R < 275 -> play_sound(Ouch);
- true -> play_sound(Bonk)
- end;
- bomb -> play_sound(Bomb);
- missed -> play_sound(Missed);
- game_over -> play_sound(Game_over);
- new_level -> play_sound(New_level);
- music -> play_sound(Music);
- start -> play_sound(Start);
- best_score -> play_sound(BestS);
- high_score -> play_sound(HighS);
- quit ->
- sounder:stop(),
- exit(normal)
- end,
- loop(Bonk, Ouch, Damn, Bomb, Missed, Game_over, New_level, Music, Start, BestS, HighS).
-
-play_sound(Snd) ->
- case catch sounder:play(Snd) of
- {'EXIT', _Reason} ->
- io:format("Cannot use audio device!\n"),
- sounder:stop(),
- silent_loop();
- _Other ->
- true
- end.
-
-silent_loop() ->
- receive
- quit ->
- exit(normal);
- _Other ->
- silent_loop()
- end.
diff --git a/lib/gs/contribs/bonk/bonk_square.erl b/lib/gs/contribs/bonk/bonk_square.erl
deleted file mode 100644
index 98af91944b..0000000000
--- a/lib/gs/contribs/bonk/bonk_square.erl
+++ /dev/null
@@ -1,146 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(bonk_square).
--export([start/1,init/5,alarm/3]).
-
-
-
-start(Bmp) ->
- spawn_link(bonk_square, init, [Bmp, self(),
- random:uniform(10000),
- random:uniform(10000),
- random:uniform(10000)]).
-
-init(Bmp, BoardPid, Seed1, Seed2, Seed3) ->
- random:seed(Seed1,Seed2,Seed3),
- idle(Bmp, BoardPid).
-
-
-idle(Bmp, BoardPid) ->
- receive
- start ->
- Level = 1,
- sleep(Level, Bmp, BoardPid, alarm(sleep_time(Level), wake_up));
- quit ->
- exit(normal);
- _Other ->
- idle(Bmp, BoardPid)
- end.
-
-
-sleep(Level, Bmp, BoardPid, Alarm) ->
- receive
- stop ->
- Alarm ! quit,
- idle(Bmp, BoardPid);
- quit ->
- Alarm ! quit,
- exit(normal);
- {new_level, NewLevel} ->
- sleep(NewLevel, Bmp, BoardPid, Alarm);
- {Alarm, wake_up} ->
- show_me(BoardPid, Bmp),
- show(Level, Bmp, BoardPid, alarm(2500, missed));
- _Other ->
- sleep(Level, Bmp, BoardPid, Alarm)
- end.
-
-
-show(Level, Bmp, BoardPid, Alarm) ->
- receive
- stop ->
- Alarm ! quit,
- idle(Bmp, BoardPid);
- quit ->
- Alarm ! quit,
- exit(normal);
- {new_level, NewLevel} ->
- show(NewLevel, Bmp, BoardPid, Alarm);
- sleep -> % The board was too crowded.
- Alarm ! quit,
- sleep(Level, Bmp, BoardPid, alarm(sleep_time(Level), wake_up));
- bonk ->
- bonk_me(BoardPid, Bmp),
- Alarm ! quit,
- bbmed(Level, Bmp, BoardPid, alarm(1500, hide));
- bomb ->
- bomb_me(BoardPid, Bmp),
- Alarm ! quit,
- bbmed(Level, Bmp, BoardPid, alarm(1000, hide));
- {Alarm, missed} ->
- missed_me(BoardPid, Bmp),
- bbmed(Level, Bmp, BoardPid, alarm(1500, hide));
- _Other ->
- show(Level, Bmp, BoardPid, Alarm)
- end.
-
-%% bonked, bombed or missed
-bbmed(Level, Bmp, BoardPid, Alarm) ->
- receive
- stop ->
- Alarm ! quit,
- idle(Bmp, BoardPid);
- quit ->
- Alarm ! quit,
- exit(normal);
- {new_level, NewLevel} ->
- bbmed(NewLevel, Bmp, BoardPid, Alarm);
- {Alarm, hide} ->
- hide_me(BoardPid, Bmp),
- sleep(Level, Bmp, BoardPid, alarm(sleep_time(Level), wake_up));
- _Other ->
- bbmed(Level, Bmp, BoardPid, Alarm)
- end.
-
-
-show_me(BoardPid, Bmp) ->
- BoardPid ! {show, self(), Bmp}.
-
-hide_me(BoardPid, Bmp) ->
- BoardPid ! {hide, self(), Bmp}.
-
-bonk_me(BoardPid, Bmp) ->
- BoardPid ! {bonked, self(), Bmp}.
-
-bomb_me(BoardPid, Bmp) ->
- BoardPid ! {bombed, self(), Bmp}.
-
-missed_me(BoardPid, Bmp) ->
- BoardPid ! {missed, self(), Bmp}.
-
-
-%% Count sleep time
-
-sleep_time(Level) ->
- random:uniform((19000 div (Level+1))*2+1500).
-
-%% Set an alarm
-
-alarm(Time, Msg) ->
- spawn(bonk_square, alarm, [Time, Msg, self()]).
-
-alarm(Time, Msg, Pid) ->
- receive
- quit -> exit(normal)
- after
- Time -> Pid ! {self(), Msg}
- end.
diff --git a/lib/gs/contribs/bonk/sounder.erl b/lib/gs/contribs/bonk/sounder.erl
deleted file mode 100644
index aabcaa1950..0000000000
--- a/lib/gs/contribs/bonk/sounder.erl
+++ /dev/null
@@ -1,160 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(sounder).
--export([start/0,play/1,new/1,go/0,stop/0,nosound/0,silent/0]).
--include_lib("kernel/include/file.hrl").
-%%----------------------------------------------------------------------
-%% sounder.erl - An interface to /dev/audio
-%%
-%% Created by: {lennarto,mike}@erix.ericsson.se
-%% Modified by: EV,[email protected]
-%%
-%% Mod: 6 Jun 1996 by [email protected]
-%% The executable sounder will no be looked for in the
-%% same directory as from where sounder.jam is loaded.
-%%
-%%
-%% start() - Returns either: ok ,or: silent ,where silent means
-%% that no audio capabilities exists but the sounder
-%% will work "silently" in order to not break any code.
-%%
-%% stop() - Returns: ok
-%%
-%% new(File) - Tries to load the File. At success, a number refering
-%% to the File is returned that shall be used with send/1.
-%% Otherwise {error,Reason} is returned.
-%%
-%% play(No) - Tries to execute the sound registered with the number No
-%% Returns: ok , or: {error,Reason}
-%%
-%% silent() - Returns: true ,if no audio capabilities exists, else: false
-%%
-%% Note: It is also possible to receive: {error,sounder_not_started}
-%%
-%%----------------------------------------------------------------------
-
-start() ->
- case whereis(sounder) of
- undefined ->
- %% first we check if the workstation has audio capabilities
- case file:read_file_info('/dev/audio') of
- {ok, FI} when FI#file_info.access==read_write ->
- register(sounder, spawn(sounder,go,[])),
- ok;
- _Other ->
- register(sounder, spawn(sounder,nosound,[])),
- silent
- end;
- _Pid ->
- ok
- end.
-
-stop() ->
- catch begin check(),
- sounder ! {stop},
- ok end.
-
-new(File) when is_list(File) -> new(list_to_atom(File));
-new(File) when is_atom(File) ->
- catch begin check(),
- sounder ! {new,File,self()},
- wait_for_ack(sounder) end.
-
-play(No) when is_integer(No) ->
- catch begin check(),
- sounder ! {play, No, self()},
- wait_for_ack(sounder) end.
-
-silent() ->
- catch begin check(),
- sounder ! {play,silent,self()},
- receive {sounder,Answer} -> Answer end end.
-
-go() ->
- Port = open_port({spawn,lists:append(bonk:bonk_dir(), "sounder")},[{packet, 2}]),
- loop(Port).
-
-loop(Port) ->
- receive
- {new, File, From} when is_atom(File) ->
- Port ! {self(),{command,lists:append([0],atom_to_list(File))}},
- From ! {sounder,wait_for_ack(Port)},
- loop(Port);
- {play,silent,From} ->
- From ! {sounder,false},
- loop(Port);
- {play,No,From} when is_integer(No) ->
- Port ! {self(),{command,[No]}},
- From ! {sounder,wait_for_ack(Port)},
- loop(Port);
- {stop} ->
- Port ! {self(),close},
- exit(normal);
- _ ->
- loop(Port)
- end.
-
-%% The application using sounds can check on silence itself
-%% and refrain from playing sounds.
-%% Or it can try to play sounds that will be "consumed in silence"
-
-nosound() ->
- receive
- {new,File,From} when is_atom(File) ->
- From ! {sounder,{ok,silent}},
- nosound();
- {play,silent,From} ->
- From ! {sounder,true},
- nosound();
- {play,No,From} when is_integer(No) ->
- From ! {sounder,{error,no_audio_cap}},
- nosound();
- {stop} ->
- exit(normal);
- _ ->
- nosound()
- end.
-
-wait_for_ack(sounder) ->
- receive {sounder,Res} -> Res end;
-wait_for_ack(Port) when is_port(Port) ->
- receive
- {Port,{data,"ok"}} ->
- ok;
- {Port,{data,[No]}} ->
- {ok,No};
- {Port,{data,Msg}} ->
- {error,list_to_atom(Msg)};
- {'EXIT',Port,_} ->
- exit(port_exited)
- end.
-
-check() ->
- case whereis(sounder) of
- Pid when is_pid(Pid) ->
- ok;
- undefined ->
- throw({error,sounder_not_started})
- end.
-
-
-
diff --git a/lib/gs/contribs/bonk/sounds/bonk.au b/lib/gs/contribs/bonk/sounds/bonk.au
deleted file mode 100644
index 5e6518898b..0000000000
--- a/lib/gs/contribs/bonk/sounds/bonk.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/damn.au b/lib/gs/contribs/bonk/sounds/damn.au
deleted file mode 100644
index 6117506fb4..0000000000
--- a/lib/gs/contribs/bonk/sounds/damn.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/explosion.au b/lib/gs/contribs/bonk/sounds/explosion.au
deleted file mode 100644
index 78a6964f1a..0000000000
--- a/lib/gs/contribs/bonk/sounds/explosion.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/gameover.au b/lib/gs/contribs/bonk/sounds/gameover.au
deleted file mode 100644
index ca7628f3c6..0000000000
--- a/lib/gs/contribs/bonk/sounds/gameover.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/hehee.au b/lib/gs/contribs/bonk/sounds/hehee.au
deleted file mode 100644
index 10cd16b596..0000000000
--- a/lib/gs/contribs/bonk/sounds/hehee.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/level.au b/lib/gs/contribs/bonk/sounds/level.au
deleted file mode 100644
index 0508c2a6ae..0000000000
--- a/lib/gs/contribs/bonk/sounds/level.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/missedme.au b/lib/gs/contribs/bonk/sounds/missedme.au
deleted file mode 100644
index 4c07c9d428..0000000000
--- a/lib/gs/contribs/bonk/sounds/missedme.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/music.au b/lib/gs/contribs/bonk/sounds/music.au
deleted file mode 100644
index ead6ec79b2..0000000000
--- a/lib/gs/contribs/bonk/sounds/music.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/ouch!!!.au b/lib/gs/contribs/bonk/sounds/ouch!!!.au
deleted file mode 100644
index 78bcf48074..0000000000
--- a/lib/gs/contribs/bonk/sounds/ouch!!!.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/praisejesus.au b/lib/gs/contribs/bonk/sounds/praisejesus.au
deleted file mode 100644
index e299bf66d6..0000000000
--- a/lib/gs/contribs/bonk/sounds/praisejesus.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/trumpet.au b/lib/gs/contribs/bonk/sounds/trumpet.au
deleted file mode 100644
index 2f551b436a..0000000000
--- a/lib/gs/contribs/bonk/sounds/trumpet.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/bonk/sounds/yes.au b/lib/gs/contribs/bonk/sounds/yes.au
deleted file mode 100644
index c1ce7dfb69..0000000000
--- a/lib/gs/contribs/bonk/sounds/yes.au
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/cols/Makefile b/lib/gs/contribs/cols/Makefile
deleted file mode 100644
index 34a900e5ab..0000000000
--- a/lib/gs/contribs/cols/Makefile
+++ /dev/null
@@ -1,103 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2012. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(GS_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= \
- cols \
- highscore
-
-HRL_FILES=
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES)
-
-TOOLNAME = cols
-
-EXTRA_FILES=
-TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif help.gif
-TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_COMPILE_FLAGS +=
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-debug opt: $(TARGET_FILES)
-
-docs:
-
-clean:
- rm -f $(TARGET_FILES)
- rm -f core
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-
-$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif
- $(gen_verbose)rm -f $@
- $(V_at)cp $(TOOLNAME).gif $@
-
-$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool
- $(gen_verbose)rm -f $@
- $(V_at)cp $(TOOLNAME).tool $@
-
-$(EBIN)/help.gif: help.gif
- $(gen_verbose)rm -f $@
- $(V_at)cp help.gif $@
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/cols/bitmaps"
- $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/cols/bitmaps"
- $(INSTALL_DIR) "$(RELSYSDIR)/cols"
- $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/cols"
-
-release_docs_spec:
-
diff --git a/lib/gs/contribs/cols/cols.erl b/lib/gs/contribs/cols/cols.erl
deleted file mode 100644
index 265f2b6ee8..0000000000
--- a/lib/gs/contribs/cols/cols.erl
+++ /dev/null
@@ -1,625 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(cols).
--compile([{nowarn_deprecated_function,{gs,config,2}},
- {nowarn_deprecated_function,{gs,create,3}},
- {nowarn_deprecated_function,{gs,create,4}},
- {nowarn_deprecated_function,{gs,destroy,1}},
- {nowarn_deprecated_function,{gs,read,2}},
- {nowarn_deprecated_function,{gs,start,0}}]).
-
--export([start/0, init/0]).
-
-%% internal export.
--export([make_board_elem/3]).
-
-%%======================================================================
-%% Contents
-%%=====================
-%% 1. The actual program
-%% 2. Graphics
-%% 3. Data structures and stuff
-%% 4. Lambdas
-%%======================================================================
-
-
--define(COLORS, {red,green,blue,grey,yellow,{66,153,130}}).
--define(HIGHFILE, "./cols.high").
--define(HEIGHT, 17).
--define(LEFT, 50).
--define(SIZE, 15).
--define(VERSION, "v0.9").
--define(WIDTH, 8).
-
--record(state, {bit,board,nextbit,ticks, score=0}).
-%%----------------------------------------------------------------------
-%% Consists of three boxes.
-%%----------------------------------------------------------------------
--record(bit, {x,y,topColor, middleColor, bottomColor,
- top_gsobj,mid_gsobj,bot_gsobj}).
-
-%%======================================================================
-%% 1. The actual program
-%%======================================================================
-
-start() ->
- spawn_link(cols,init,[]).
-
-init() ->
- make_graphics(),
- {A,B,C} = erlang:now(),
- random:seed(A,B,C),
- NextBit = make_bit(),
- Board = make_screen_board(),
- S = #state{bit=make_bit(), board=Board, ticks=update_timer(1),
- score=make_score(), nextbit=new_bit_xy(NextBit, -2,5)},
- gs:config(win, [{map, true}]),
- loop(S).
-
-make_graphics() ->
- G = gs:start(),
- H = ?HEIGHT*?SIZE,
- W = ?WIDTH*?SIZE,
- BotMargin = 100,
- gs:create(window, win, G, [{destroy,true},{map, true},{title, "cols"},
- {height, H+BotMargin}, {width, W+?LEFT+10},
- {bg, grey},{keypress,true}]),
- gs:create(canvas, can, win, [{bg, black},
- {height, H+BotMargin},
- {width, W+?LEFT+20}]),
- gs:create(text, can, [{text, "Next"}, {coords, [{5, 45}]}, {fg, red}]),
- gs:create(image, help, can, [{coords,[{5,7}]},
- {load_gif, dir() ++ "/help.gif"},
- {buttonpress,true}]),
- draw_borders().
-
-loop(State) ->
- receive
- Event -> loop(update(Event, State))
- end.
-
-%%----------------------------------------------------------------------
-%% How fast speed should be doubled
-%%----------------------------------------------------------------------
--define(DBL_TICKS, 300).
-
-update_timer(Ticks) ->
- K = 0.001/?DBL_TICKS,
- M = 1.001-K,
- Q = K*Ticks+M,
- Timeout = round(1/math:log(Q)),
- timer:send_after(Timeout, self(), fall_timeout),
- Ticks+1.
-
-add_score({ScoreObj, NScore}, DScore) ->
- NScore2 = NScore + DScore,
- gs:config(ScoreObj, [{text, io_lib:format("Score: ~w", [NScore2])}]),
- {ScoreObj, NScore2}.
-
-
-update({gs,_Obj,keypress,_Data, ['Left'|_]}, State) ->
- #state{bit=Bit, board = Board} = State,
- #bit{x=X,y=Y} = Bit,
- if X > 0 ->
- case is_board_empty(Board, X-1,Y) of
- true ->
- State#state{bit=new_bit_xy(Bit, X-1, Y)};
- false ->
- State
- end;
- true -> State
- end;
-
-update({gs,_Obj,keypress,_Data, ['Right'|_]}, State) ->
- #state{bit=Bit, board = Board} = State,
- #bit{x=X,y=Y} = Bit,
- if X < ?WIDTH - 1 ->
- case is_board_empty(Board, X+1, Y) of
- true ->
- State#state{bit=new_bit_xy(Bit, X+1, Y)};
- false ->
- State
- end;
- true -> State
- end;
-
-update({gs,_Obj,keypress,_Data, ['Up'|_]}, State) ->
- State#state{bit=shift_bits(State#state.bit)};
-
-update({gs,_Obj,keypress,_Data, [Key|_]}, State) ->
- case drop_key(Key) of
- true ->
- #state{bit=Bit, board=Board, score=Score} = State,
- #bit{x=X,y=Y} = Bit,
- {NewX, NewY, NewScore} = drop(X,Y,Score,Board),
- fasten_bit(State#state{bit=new_bit_xy(Bit,NewX, NewY),
- score=NewScore});
- false -> State
- end;
-
-update(fall_timeout, State) ->
- #state{bit=Bit, board=Board, ticks = Ticks, score=Score} = State,
- NewY = Bit#bit.y+1,
- X = Bit#bit.x,
- case is_fall_ok(Board, X, NewY) of
- true ->
- State#state{bit=new_bit_xy(Bit, X, NewY),
- ticks=update_timer(Ticks), score=add_score(Score, 1)};
- false ->
- S1 = fasten_bit(State),
- S1#state{ticks=update_timer(Ticks)}
- end;
-
-update({gs,_,destroy,_,_}, _State) ->
- exit(normal);
-
-update({gs,help,buttonpress,_,_}, State) ->
- show_help(),
- State;
-
-update(OtherEvent, State) ->
- ok=io:format("got other! ~w~n", [OtherEvent]), State.
-
-drop_key('Down') -> true;
-drop_key(space) -> true;
-drop_key(_) -> false.
-
-is_board_empty(Board, X, Y) ->
- case {color_at(Board, X, Y),
- color_at(Board, X, Y + 1),
- color_at(Board, X, Y + 2)} of
- {black, black, black} -> true;
- _ -> false
- end.
-
-%%----------------------------------------------------------------------
-%% Returns: NewState
-%%----------------------------------------------------------------------
-fasten_bit(State) ->
- #state{board=Board, bit=Bit, nextbit=NextBit, score=Score} = State,
- #bit{x=X,y=Y,topColor=C1,middleColor=C2,bottomColor=C3} = Bit,
- B1 = update_screen_element(Board, X, Y, C1),
- B2 = update_screen_element(B1, X, Y+1, C2),
- B3 = update_screen_element(B2, X, Y+2, C3),
- destroy_bit(Bit),
- #bit{topColor=NC1,middleColor=NC2,bottomColor=NC3} = NextBit,
- {B4, ExtraScore} = erase_bits(B3, [{X,Y},{X,Y+1},{X,Y+2}], 0),
- NewBit = make_bit(NC1,NC2,NC3),
- case is_board_empty(B4, NewBit#bit.x, NewBit#bit.y) of
- true ->
- State#state{score=add_score(Score, ExtraScore),
- bit=NewBit, nextbit=new_colors(NextBit),board=B4};
- false ->
- {_GsObj,Score2}=State#state.score,
- highscore:run(Score2,?HIGHFILE),
- exit(normal)
- end.
-
-%%----------------------------------------------------------------------
-%% Args: Check: list of {X,Y} to check.
-%% Returns: {NewBoard, ExtraScore}
-%%----------------------------------------------------------------------
-erase_bits(Board, Checks, ExtraScore) ->
- ElemsToDelete = elems2del(Checks,Board,[]),
- NDel = length(ElemsToDelete),
- if
- NDel > 0 ->
- Board2 = delete_elems(Board, ElemsToDelete),
- {NewBoard, NewCheck} = fall_down(Board2, ElemsToDelete),
- if NDel > 3 ->
- {B,ES}=erase_bits(NewBoard,NewCheck,ExtraScore+2*NDel),
- {NewBoard2, NewCheck2} = bonus(B, NewCheck),
- erase_bits(NewBoard2, NewCheck2, ES);
- true ->
- erase_bits(NewBoard, NewCheck, 2*NDel)
- end;
- true -> {Board, ExtraScore}
- end.
-
-bonus(Board, Check) ->
- Cols = collect_bottom_bits(0,Board),
- NewBoard = randomize_columns(5, Board, Cols),
- NewCheck = update_check(Check, Cols),
- {NewBoard, NewCheck}.
-
-randomize_columns(0, Board, _) -> Board;
-randomize_columns(N, Board, Cols) ->
- NewBoard = randomize_columns(Cols,Board),
- randomize_columns(N-1, NewBoard, Cols).
-
-randomize_columns([],Board) -> Board;
-randomize_columns([X|Xs],Board) ->
- flush(),
- timer:sleep(50),
- randomize_columns(Xs,update_screen_element(Board,X,?HEIGHT-1,rndColor())).
-
-%%----------------------------------------------------------------------
-%% Returns: NewBoard
-%%----------------------------------------------------------------------
-delete_elems(Board, Elems2Del) ->
- OrgObjs = org_objs(Elems2Del,Board),
- visual_effect(?SIZE, OrgObjs),
- NewBoard = update_board(Elems2Del, Board),
- put_back(OrgObjs),
- NewBoard.
-
-visual_effect(0,_OrgObjs) -> done;
-visual_effect(Size,OrgObjs) ->
- set_size(OrgObjs,Size),
- flush(),
- timer:sleep(20),
- visual_effect(Size-1,OrgObjs).
-
-set_size([],_Size) -> done;
-set_size([{GsObj,[{X1,Y1},{_X2,_Y2}]}|T],Size) ->
- gs:config(GsObj, [{coords, [{X1,Y1},{X1+Size,Y1+Size}]}]),
- set_size(T,Size).
-
-%%----------------------------------------------------------------------
-%% Note: Loop over columns where something is removed only. (efficiency)
-%% Returns: {ReversedNewColumns (perhaps shorter), Checks}
-%% cols:fall_column([a,b,black,black,c,f,black,d,black], 3, 15, [], []).
-%% should return: {[a,b,c,f,d],[{3,11},{3,12},{3,13}]}
-%%----------------------------------------------------------------------
-fall_column([], _X, _Y, ColumnAcc, ChecksAcc) ->
- {ColumnAcc, ChecksAcc};
-fall_column([black|Colors], X, Y, ColumnAcc, ChecksAcc) ->
- case find_box(Colors) of
- false -> {ColumnAcc, ChecksAcc};
- NewColors when is_list(NewColors) ->
- fall_one_step(NewColors, X, Y, ColumnAcc, ChecksAcc)
- end;
-fall_column([Color|Colors], X, Y, ColumnAcc, ChecksAcc) ->
- fall_column(Colors, X, Y-1, [Color | ColumnAcc], ChecksAcc).
-
-find_box([]) -> false;
-find_box([black|Colors]) ->
- find_box(Colors);
-find_box([Color|Colors]) -> [Color|Colors].
-
-%%----------------------------------------------------------------------
-%% Enters: ([a,b, , ,c,d], 3, 8, Q)
-%% Leaves: ([b,a|Q], [ , , ,c,d], 10, [{3,8},{4,9}])
-%%----------------------------------------------------------------------
-fall_one_step([], X, Y, ColumnAcc, Checks) ->
- fall_column([], X, Y, ColumnAcc, Checks);
-fall_one_step([black|Colors], X, Y, ColumnAcc, Checks) ->
- fall_column([black|Colors], X, Y, ColumnAcc, Checks);
-fall_one_step([Color|Colors], X, Y, ColumnAcc, Checks) ->
- fall_one_step(Colors, X, Y-1, [Color|ColumnAcc],[{X,Y}|Checks]).
-
-%%----------------------------------------------------------------------
-%% Returns: {NewBoard, NewChecks}
-%%----------------------------------------------------------------------
-fall_down(Board1, Elems2Del) ->
- UpDatedCols = updated_cols(Elems2Del, []),
- fall_column(UpDatedCols, Board1, []).
-
-fall_column([], NewBoard, NewChecks) -> {NewBoard, NewChecks};
-fall_column([X|Xs], BoardAcc, ChecksAcc) ->
- OrgColumn = boardcolumn_to_tuple(BoardAcc, X),
- Column = columntuple_to_list(OrgColumn),
- {NewColumn, NewChecksAcc} = fall_column(Column, X,?HEIGHT-1,[],ChecksAcc),
- NewBoardAcc =
- set_board_column(BoardAcc,X,new_column_list(NewColumn,OrgColumn)),
- fall_column(Xs,NewBoardAcc,NewChecksAcc).
-
-new_column_list(NewColumn, ColumnTuple) ->
- Nempty = ?HEIGHT - length(NewColumn),
- L = make_list(black, Nempty) ++ NewColumn,
- new_column_list(L, 1, ColumnTuple).
-
-new_column_list([H|T], N, Tuple) ->
- {GsObj, Color} = element(N, Tuple),
- [update_screen_element({GsObj, Color},H) | new_column_list(T, N+1, Tuple)];
-new_column_list([], _, _) -> [].
-
-
-%%----------------------------------------------------------------------
-%% Returns: a reversed list of colors.
-%%----------------------------------------------------------------------
-columntuple_to_list(ColumnTuple) when is_tuple(ColumnTuple) ->
- columntuple_to_list(tuple_to_list(ColumnTuple),[]).
-
-columntuple_to_list([],Acc) -> Acc;
-columntuple_to_list([{_GsObj, Color}|T],Acc) ->
- columntuple_to_list(T,[Color|Acc]).
-
-%%======================================================================
-%% 2. Graphics
-%%======================================================================
-
-make_bit() ->
- make_bit(rndColor(),rndColor(),rndColor()).
-
-make_bit(Tc,Mc,Bc) ->
- X = ?WIDTH div 2,
- Y = 0,
- #bit{x=X,y=Y,topColor= Tc, middleColor=Mc, bottomColor=Bc,
- top_gsobj = make_box(X,Y,Tc), mid_gsobj=make_box(X,Y+1,Mc),
- bot_gsobj=make_box(X,Y+2,Bc)}.
-
-new_colors(Bit) ->
- #bit{top_gsobj=T,mid_gsobj=M,bot_gsobj=B} = Bit,
- Tc = rndColor(),
- Mc = rndColor(),
- Bc = rndColor(),
- gs:config(T, [{fill, Tc}]),
- gs:config(M, [{fill, Mc}]),
- gs:config(B, [{fill, Bc}]),
- Bit#bit{topColor= Tc, middleColor=Mc, bottomColor=Bc}.
-
-new_bit_xy(Bit, NewX, NewY) ->
- #bit{x=X,y=Y,top_gsobj=T,mid_gsobj=M,bot_gsobj=B} = Bit,
- Dx = (NewX - X) * ?SIZE,
- Dy = (NewY - Y) * ?SIZE,
- gs:config(T, [{move, {Dx, Dy}}]),
- gs:config(M, [{move, {Dx, Dy}}]),
- gs:config(B, [{move, {Dx, Dy}}]),
- Bit#bit{x=NewX, y=NewY}.
-
-destroy_bit(#bit{top_gsobj=T,mid_gsobj=M,bot_gsobj=B}) ->
- gs:destroy(T),
- gs:destroy(M),
- gs:destroy(B).
-
-shift_bits(Bit) ->
- #bit{topColor=C1,middleColor=C2,bottomColor=C3,
- top_gsobj=T,mid_gsobj=M,bot_gsobj=B} = Bit,
- gs:config(T, {fill,C2}),
- gs:config(M, {fill,C3}),
- gs:config(B, {fill,C1}),
- Bit#bit{topColor=C2, middleColor=C3, bottomColor=C1}.
-
-rndColor() ->
- Siz = size(?COLORS),
- element(random:uniform(Siz), ?COLORS).
-
-make_score() ->
- {gs:create(text, can, [{text, "Score: 0"}, {fg, red},
- {coords, [{5,?HEIGHT*?SIZE+10}]}]), 0}.
-
-make_screen_board() ->
- xy_loop({cols,make_board_elem}, make_board(), ?WIDTH, ?HEIGHT).
-
-make_board_elem(X,Y,Board) ->
- set_board_element(Board,X,Y,{make_box(X,Y,black),black}).
-
-flush() -> gs:read(can, bg).
-
-draw_borders() ->
- BotY = ?HEIGHT*?SIZE,
- RightX = ?LEFT + ?SIZE*?WIDTH,
- LeftX = ?LEFT - 1,
- gs:create(line,can,[{coords,[{LeftX,0},{LeftX,BotY}]},{fg,white}]),
- gs:create(line,can,[{coords,[{LeftX,BotY},{RightX,BotY}]},{fg,white}]),
- gs:create(line,can,[{coords,[{RightX,0},{RightX, BotY}]}, {fg,white}]).
-
-update_screen_element(ScrBoard, X, Y, Color) ->
- case board_element(ScrBoard,X,Y) of
- {_GsObj, Color} ->
- ScrBoard; % don't have to update screen
- {GsObj, _ScreenColor} ->
- gs:config(GsObj, color_args(Color)),
- set_board_element(ScrBoard, X, Y, {GsObj, Color})
- end.
-
-update_screen_element(ScrElem, Color) ->
- case ScrElem of
- {_GsObj, Color} ->
- ScrElem; % don't have to update screen
- {GsObj, _ScreenColor} ->
- gs:config(GsObj, color_args(Color)),
- {GsObj, Color}
- end.
-
-
-color_args(black) -> [{fg,black},{fill,black}];
-color_args(Color) -> [{fg,white},{fill,Color}].
-
-%%======================================================================
-%% 3. Data structures and stuff
-%%======================================================================
-
-xy_loop(Fun, Acc, XMax, YMax) ->
- xy_loop(Fun, Acc, 0, 0, XMax, YMax).
-
-xy_loop(_Fun, Acc, _X, YMax, _XMax, YMax) -> Acc;
-xy_loop(Fun, Acc, XMax, Y, XMax, YMax) ->
- xy_loop(Fun, Acc, 0, Y+1, XMax, YMax);
-xy_loop(Fun, Acc, X, Y, XMax, YMax) ->
- xy_loop(Fun, apply(Fun, [X, Y,Acc]), X+1,Y,XMax, YMax).
-
-%%----------------------------------------------------------------------
-%% Returns: a sorted list of {X,Y} to delete.
-%% Pre: PrevDelElems is sorted.
-%%----------------------------------------------------------------------
-erase_bits_at(Board, PrevDelElems, X,Y) ->
- C = color_at(Board, X, Y),
- erase_bits_at([vert, horiz, slash, backslash],X,Y,C,Board,PrevDelElems).
-
-erase_bits_at([], _X,_Y,_C,_Board, Elems2Del) -> Elems2Del;
-erase_bits_at([Dir|Ds],X,Y,C,Board, Elems2DelAcc) ->
- Dx = dx(Dir),
- Dy = dy(Dir),
- DelElems = lists:append(check_dir(Board, X-Dx,Y-Dy,-Dx,-Dy,C),
- check_dir(Board, X,Y,Dx,Dy,C)),
- N_in_a_row = length(DelElems),
- if N_in_a_row >= 3 ->
- erase_bits_at(Ds,X,Y,C,Board,
- ordsets:union(lists:sort(DelElems),Elems2DelAcc));
- true -> erase_bits_at(Ds,X,Y,C,Board,Elems2DelAcc)
- end.
-
-dx(vert) -> 0;
-dx(horiz) -> 1;
-dx(slash) -> 1;
-dx(backslash) -> -1.
-
-dy(vert) -> -1;
-dy(horiz) -> 0;
-dy(slash) -> -1;
-dy(backslash) -> -1.
-
-
-%%----------------------------------------------------------------------
-%% Returns: list of {X,Y} to delete.
-%%----------------------------------------------------------------------
-check_dir(Board, X, Y, Dx, Dy, Color)
- when X >= 0, X < ?WIDTH, Y >= 0, Y < ?HEIGHT ->
- case color_at(Board, X, Y) of
- Color ->
- [{X,Y} | check_dir(Board, X+Dx, Y+Dy, Dx, Dy, Color)];
- _OtherColor ->
- []
- end;
-check_dir(_Board, _X, _Y, _Dx, _Dy, _Color) -> [].
-
-make_box(X, Y, Color) ->
- make_box(X, Y, 1, 1, Color).
-
-%%----------------------------------------------------------------------
-%% Returns: GsObj
-%%----------------------------------------------------------------------
-make_box(X, Y, Height, Width, Color) ->
- Opts = if Color == black -> [{fg, black}, {fill, black}];
- true -> [{fill, Color}, {fg, white}] end,
- gs:create(rectangle, can, [{coords, [{?LEFT + X * ?SIZE, Y * ?SIZE},
- {?LEFT + X * ?SIZE + (?SIZE*Width)-1,
- Y * ?SIZE + (?SIZE*Height)-1}]}|Opts]).
-
-is_fall_ok(_Board, _NewX, NewY) when NewY+2 >= ?HEIGHT -> false;
-is_fall_ok(Board, NewX, NewY) ->
- case color_at(Board, NewX, NewY+2) of
- black ->
- true;
- _ -> false
- end.
-
-color_at(Board, X, Y) ->
- {_GsObj, Color} = board_element(Board, X, Y),
- Color.
-
-
-%%----------------------------------------------------------------------
-%% X:0..?WIDTH-1, Y:0..?HEIGHT
-%%----------------------------------------------------------------------
-make_board() ->
- list_to_tuple(make_list(make_column(), ?WIDTH)).
-
-board_element(Board, X, Y) ->
- element(Y+1, element(X+1, Board)).
-
-set_board_element(Board, X, Y, NewValue) ->
- Col = element(X+1, Board),
- NewCol=setelement(Y+1,Col, NewValue),
- setelement(X+1, Board, NewCol).
-
-make_column() ->
- list_to_tuple(make_list(black, ?HEIGHT)).
-
-make_list(_Elem, 0) -> [];
-make_list(Elem, N) -> [Elem|make_list(Elem,N-1)].
-
-boardcolumn_to_tuple(Board, X) ->
- element(X+1, Board).
-
-set_board_column(Board, X, NewCol) when length(NewCol) == ?HEIGHT ->
- setelement(X+1, Board, list_to_tuple(NewCol)).
-
-show_help() ->
- W = gs:create(window, win, [{title, "cols Help"}, {width, 300},
- {height,300}, {map, true}]),
- gs:create(label, W, [{x,0},{y,0},{height, 200},{width,300},{justify,center},
- {label, {text,
- "cols $Revision: 1.23 $"
- "\nby\n"
- "Klas Eriksson, [email protected]\n\n"
- "Help: Use arrows and space keys.\n"
- " Try to get 3 in-a-row.\n"
- " More than 3 gives bonus."}}]),
- B=gs:create(button, W, [{x,100},{y,250}, {label, {text, "Dismiss"}}]),
- receive
- {gs, B, click, _, _} -> ok
- end,
- gs:destroy(W).
-
-%%======================================================================
-%% 4. Lambdas
-%%======================================================================
-
-drop(X,Y,Score,Board) ->
- case is_fall_ok(Board, X, Y+1) of
- true -> drop(X,Y+1,add_score(Score, 1),Board);
- false -> {X,Y, Score}
- end.
-
-elems2del([], _Board,Elems2DelAcc) -> Elems2DelAcc;
-elems2del([{X,Y}|Checks],Board,Elems2DelAcc) ->
- NewElems2DelAcc = ordsets:union(erase_bits_at(Board,Elems2DelAcc,X,Y),
- Elems2DelAcc),
- elems2del(Checks,Board,NewElems2DelAcc).
-
-collect_bottom_bits(?WIDTH,_Board) -> [];
-collect_bottom_bits(X,Board) ->
- case color_at(Board, X, ?HEIGHT-1) of
- black -> collect_bottom_bits(X+1,Board);
- _AcolorHere -> [X|collect_bottom_bits(X+1,Board)]
- end.
-
-update_check(_Check,[]) -> [];
-update_check(Check,[X|Xs]) ->
- case lists:member({X, ?HEIGHT-1}, Check) of
- true -> update_check(Check,Xs);
- false -> [{X, ?HEIGHT-1}|update_check(Check,Xs)]
- end.
-
-org_objs([],_Board) -> [];
-org_objs([{X,Y}|XYs],Board) ->
- {GsObj, _Color} = board_element(Board, X, Y),
- [{GsObj, lists:sort(gs:read(GsObj, coords))}|org_objs(XYs,Board)].
-
-update_board([],Board) -> Board;
-update_board([{X,Y}|XYs], Board) ->
- update_board(XYs,update_screen_element(Board, X, Y, black)).
-
-put_back([]) -> done;
-put_back([{GsObj, Coords}|Objs]) ->
- gs:config(GsObj, [{coords, Coords}]),
- put_back(Objs).
-
-updated_cols([], UpdColsAcc) -> UpdColsAcc;
-updated_cols([{X,_Y}|XYs], UpdColsAcc) ->
- case lists:member(X,UpdColsAcc) of
- true -> updated_cols(XYs,UpdColsAcc);
- false -> updated_cols(XYs,[X|UpdColsAcc])
- end.
-
-%% This is not an application so we don't have their way of knowing
-%% a private data directory where the GIF files are located (this directory).
-%% We can find GS and makes it relative from there /kgb
-
--define(EbinFromGsPriv,"../contribs/ebin").
-
-dir()->
- GsPrivDir = code:priv_dir(gs),
- filename:join(GsPrivDir,?EbinFromGsPriv).
diff --git a/lib/gs/contribs/cols/cols.gif b/lib/gs/contribs/cols/cols.gif
deleted file mode 100644
index 96e7c1ed4a..0000000000
--- a/lib/gs/contribs/cols/cols.gif
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/cols/cols.tool b/lib/gs/contribs/cols/cols.tool
deleted file mode 100644
index 673c3d8efa..0000000000
--- a/lib/gs/contribs/cols/cols.tool
+++ /dev/null
@@ -1,5 +0,0 @@
-{version,"0.1"}.
-{{tool,"Cols"},
- {start,{cols,start,[]}},
- {icon,"cols.gif"},
- {message,"Cols - The Game"}}.
diff --git a/lib/gs/contribs/cols/help.gif b/lib/gs/contribs/cols/help.gif
deleted file mode 100644
index 59baef1fec..0000000000
--- a/lib/gs/contribs/cols/help.gif
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/cols/highscore.erl b/lib/gs/contribs/cols/highscore.erl
deleted file mode 100644
index 94f68a043a..0000000000
--- a/lib/gs/contribs/cols/highscore.erl
+++ /dev/null
@@ -1,103 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(highscore).
--compile([{nowarn_deprecated_function,{gs,button,2}},
- {nowarn_deprecated_function,{gs,create,3}},
- {nowarn_deprecated_function,{gs,destroy,1}},
- {nowarn_deprecated_function,{gs,grid,2}},
- {nowarn_deprecated_function,{gs,read,2}},
- {nowarn_deprecated_function,{gs,start,0}},
- {nowarn_deprecated_function,{gs,window,2}}]).
-
--export([run/2]).
-
-run(NScore, File) ->
- Scores = read_scores(File),
- case find_pos(NScore, 1, Scores) of
- false ->
- display(Scores);
- Pos ->
- NewScores = new_highscore(Scores, Pos, NScore),
- write_scores(NewScores,File),
- display(NewScores)
- end.
-
-
-new_highscore(Scores, Pos, NScore) ->
- Txt = io_lib:format("You entered position ~w", [Pos]),
- W = gs:create(window, gs:start(), [{width, 200},{height, 110},{map,true},
- {title, "New Highscore!!!"}]),
- gs:create(label, W, [{label, {text, Txt}}, {x, 0}, {y,0}, {align, center},
- {width, 190},{height, 30}]),
- Entry = gs:create(entry, W, [{x, 0}, {y, 40}, {height, 30}, {width, 200}]),
- Ok = gs:create(button, W, [{label, {text, "Ok"}}, {x, 40}, {y, 75}]),
- receive
- {gs, Ok, click, _,_} ->
- T = gs:read(Entry, text),
- gs:destroy(W),
- lists:sublist(lists:reverse(
- lists:keysort(1, [{NScore, T} | Scores])), 1, 10)
- end.
-
-
-
-read_scores(File) ->
- case file:read_file(File) of
- {ok, Bin} -> binary_to_term(Bin);
- {error, _Reason} ->
- mk_empty_high(10)
- end.
-
-mk_empty_high(0) -> [];
-mk_empty_high(N) -> [{N,"Erlang"}|mk_empty_high(N-1)].
-
-find_pos(_NScore, _N, []) -> false;
-find_pos(NScore, N, [{Score, _Name} | Scores]) when Score > NScore ->
- find_pos(NScore, N+1, Scores);
-find_pos(_NScore, N, _) -> N.
-
-write_scores(Scores,File) ->
- file:write_file(File, term_to_binary(Scores)).
-
-display(Scores) ->
- Win = gs:window(gs:start(), [{width, 300},{height, 250},{map,true},
- {title, "Highscores"}]),
- {W,H} = gs:read(Win,{font_wh,{{screen,12},"aaaaaaa"}}),
- G = gs:grid(Win,[{rows,{1,11}},{columnwidths,[W,4*W]},{hscroll,false},
- {width, 300},{height, 220},{vscroll,false},
- {cellheight,H+2},{font,{screen,12}}]),
- insert_scores(G,2,Scores),
- Ok = gs:button(Win, [{label, {text, "OK"}}, {x, 100}, {y, 220}]),
- receive
- {gs, Ok, click, _,_} -> gs:destroy(Win),
- ok
- end.
-
-insert_scores(Grid,_N,[]) ->
- gs:create(gridline,Grid,[{row,1},{font,{screen,bold,12}},
- {text,{1,"SCORE"}},{text,{2,"NAME"}}]);
-
-insert_scores(Grid,Row,[{Score,Name}|Ss]) ->
- gs:create(gridline,Grid,[{row,Row},{text,{1,io_lib:format("~w",[Score])}},
- {text,{2,Name}}]),
- insert_scores(Grid,Row+1,Ss).
-
diff --git a/lib/gs/contribs/mandel/Makefile b/lib/gs/contribs/mandel/Makefile
deleted file mode 100644
index b806cc7801..0000000000
--- a/lib/gs/contribs/mandel/Makefile
+++ /dev/null
@@ -1,101 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2012. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(GS_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= \
- mandel
-
-HRL_FILES=
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES)
-
-TOOLNAME = mandel
-
-EXTRA_FILES= $(TOOLNAME).html
-TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif
-TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_COMPILE_FLAGS +=
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-debug opt: $(TARGET_FILES)
-
-docs:
-
-clean:
- rm -f $(TARGET_FILES)
- rm -f core
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-
-$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif
- $(gen_verbose)rm -f $@
- $(V_at)cp $(TOOLNAME).gif $@
-
-$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool
- $(gen_verbose)rm -f $@
- $(V_at)cp $(TOOLNAME).tool $@
-
-$(EBIN)/help.gif: help.gif
- $(gen_verbose)rm -f $@
- $(V_at)cp help.gif $@
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/mandel/bitmaps"
- $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/mandel/bitmaps"
- $(INSTALL_DIR) "$(RELSYSDIR)/mandel"
- $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/mandel"
-
-release_docs_spec:
diff --git a/lib/gs/contribs/mandel/mandel.erl b/lib/gs/contribs/mandel/mandel.erl
deleted file mode 100644
index e6061ba77d..0000000000
--- a/lib/gs/contribs/mandel/mandel.erl
+++ /dev/null
@@ -1,351 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
--module(mandel).
--compile([{nowarn_deprecated_function,{gs,assq,2}},
- {nowarn_deprecated_function,{gs,config,2}},
- {nowarn_deprecated_function,{gs,create,4}},
- {nowarn_deprecated_function,{gs,image,2}},
- {nowarn_deprecated_function,{gs,start,0}}]).
--author('(mbj,eklas)@erlang.ericsson.se').
-
-%% User's interface
--export([start/0,start/1]).
-
-%% Internal exports:
--export([start_client/2,refresher/1,start_server/1,respond/2]).
-
-%%%-----------------------------------------------------------------
-%%% Distributed Mandelbrot program.
-%%% Originally written i C++/rpc/lwp/interviews by Klas Eriksson.(1200 lines)
-%%% Rewritten in Erlang by Klas Eriksson and Martin Björklund.
-%%%-----------------------------------------------------------------
-
-%% unix>erl -sname foo (all nodes will get the same name)
-%% (foo@data)1>mandel:start([{hosts,["computer1","computer2"]},{window,400}]).
-
-%% unix>erl
-%% 1> mandel:start().
-
--record(state,{image,width,height,xmax,ymax,range,
- maxiter,colortable,zoomstep}).
--record(job,{left,right,ymin,ymax,height,width,maxiter,data=[]}).
--define(JOBWIDTH,10).
-
-%%-----------------------------------------------------------------
-%% This is the client start function.
-%%-----------------------------------------------------------------
-start() ->
- start([]).
-
-%%----------------------------------------------------------------------
-%% Option is list of Option. Option is:
-%% {xmax,float()}|{ymax,float()}|{range,float()}|
-%% {maxiter,integer()}|{window,integer()}|{zoomstep,float()}|
-%% {hosts,(list of string())|all_found_nodes}
-%%----------------------------------------------------------------------
-start(Opts) ->
- Nodes1 = nodes(),
- Nodes = case get_option(hosts,Opts,all_found_nodes) of
- all_found_nodes when Nodes1 == [] ->
- N = [node()],
- spawn(mandel,start_server,[N]),
- N;
- all_found_nodes ->
- start_nodes(dir(),Nodes1),
- Nodes1;
- Hosts ->
- start_slaves(Hosts),
- start_nodes(dir(),Nodes1),
- Nodes1
- end,
- spawn(mandel,start_client,[Opts,Nodes]).
-
-%% This is not an application so we don't have their way of knowing
-%% a private data directory where the GIF files are located (this directory).
-%% We can find GS and makes it relative from there /kgb
-
--define(EbinFromGsPriv,"../contribs/ebin").
-
-dir()->
- GsPrivDir = code:priv_dir(gs),
- filename:join(GsPrivDir,?EbinFromGsPriv).
-
-
-start_slaves([]) -> ok;
-start_slaves([Host|Hs]) ->
- {ok,Name}=slave:start(Host),
- io:format("host ~p is up~n", [Name]),
- start_slaves(Hs).
-
-start_nodes(_Dir,[]) -> ok;
-start_nodes(Dir,[Node|Nodes]) ->
- rpc:call(Node,code,add_path,[Dir]), % hack? should be done in .erlang
- spawn_link(Node,mandel,start_server,[[node()]]),
- io:format("started mandelserver at node: ~p~n", [Node]),
- start_nodes(Dir,Nodes).
-
-start_client(Opts,Nodes) ->
- Wt = get_option(window,Opts,100) div ?JOBWIDTH * ?JOBWIDTH,
- Ht = get_option(window,Opts,100) div ?JOBWIDTH * ?JOBWIDTH,
- S=gs:start(),
- Win=gs:create(window,win1,S,[{title,"Mandel"},{width,Wt-1},{height,Ht-1},
- {configure,true}]),
- Canvas=gs:create(canvas,can1,Win,[{width,Wt},{height,Ht}]),
- Image=gs:image(Canvas,[{buttonpress,true}]),
- MaxIters = get_option(maxiter,Opts,100),
- timer:apply_after(8000,mandel,refresher,[Image]),
- CT = make_color_table(MaxIters),
- State2=#state{image=Image,width=Wt,height=Ht,
- xmax=try_random(get_option(xmax,Opts,2),-2,2),
- ymax=try_random(get_option(ymax,Opts,2),-2,2),
- range=try_random(get_option(range,Opts,4),0,4),
- maxiter=MaxIters,colortable=CT,
- zoomstep=get_option(zoomstep,Opts,1.7)},
- ToDo = make_jobs(State2),
- gs:config(Win,[{map,true}]),
- main(State2, [], Nodes, ToDo).
-
-try_random(random,Low,High) ->
- random:uniform()*(High-Low)+Low;
-try_random(Float,_Low,_High) when is_number(Float) -> Float.
-
-
-%%-----------------------------------------------------------------
-%% Distribute work to the nodes. When a node returns, that
-%% node is the first to be used if there's any job left.
-%%-----------------------------------------------------------------
-main(State, [], PassiveNodes, []) ->
- wait_event(State,[],PassiveNodes,[]);
-main(State, ActiveNodes, PassiveNodes, []) ->
- % No jobs left, but some nodes are still active.
- % Wait_Event for their results
- wait_event(State,ActiveNodes,PassiveNodes,[]);
-main(State, ActiveNodes, [Node|PassiveNodes], [Job|ToDo]) ->
- % We have work to do, and at least one passive node.
- % Let him do it.
- distribute_job(Node, Job),
- main(State, [Node|ActiveNodes], PassiveNodes, ToDo);
-main(State, ActiveNodes, [], ToDo) ->
- % We have work to do, but all nodes are active.
- _Node = wait_event(State,ActiveNodes,[],ToDo).
-
-wait_event(State,ActiveNodes,PassiveNodes,ToDo) ->
- receive
- {calculation_done, {Node, Job}} ->
- if % a small hack. we want to discard data for old pictures
- Job#job.ymax==State#state.ymax ->
- draw(State, Node, Job);
- true -> true
- end,
- main(State,lists:delete(Node,ActiveNodes),[Node|PassiveNodes],ToDo);
- {gs,_Img,buttonpress,_Data,[_Butt,X,Y|_]} ->
- #state{width=W,height=H,ymax=Ymax,xmax=Xmax,range=R,zoomstep=ZS} =
- State,
- RX = Xmax-R+(X/W)*R,
- RY = Ymax-R+(1-(Y/H))*R,
- R2 = R/ZS,
- Xmax2 = RX + R2/2,
- Ymax2 = RY + R2/2,
- State2 = State#state{xmax=Xmax2,ymax=Ymax2,range=R2},
- io:format("{xmax,~w},{ymax,~w},{range,~w}~n", [Xmax2,Ymax2,R2]),
- ToDo2=make_jobs(State2),
- main(State2,ActiveNodes,PassiveNodes,ToDo2);
- {gs,_Win,destroy,_,_} ->
- kill_nodes(lists:append(ActiveNodes,PassiveNodes));
- {gs,_Win,configure,_Data,[W,H|_]}
- when State#state.width==W+1, State#state.height==H+1->
- main(State,ActiveNodes,PassiveNodes,ToDo);
- {gs,_Win,configure,_Data,[W|_]} ->
- gs:config(can1,[{width,W},{height,W}]),
- gs:config(win1,{configure,false}),
- gs:config(win1,[{width,W-1},{height,W-1}]),
- gs:config(win1,{configure,true}),
- State2 = State#state{width=W,height=W},
- ToDo2=make_jobs(State2),
- main(State2,ActiveNodes,PassiveNodes,ToDo2)
- end.
-
-kill_nodes([]) ->
- done;
-kill_nodes([Node|Nodes]) ->
- exit(rpc:call(Node,erlang,whereis,[mandel_server]),kill),
- kill_nodes(Nodes).
-
-
-distribute_job(Node, Job) ->
- {mandel_server, Node} ! {mandel_job, {self(), Job}}.
-
-draw(#state{image=Image, width=Wt, height=Ht, xmax=Xmax,
- maxiter=MI,colortable=ColorTable,range=R}, Node, Job) ->
- #job{left=Left,data=Data}=Job,
- io:format("Got data from node ~30w~n", [Node]),
-%% PixelX = K * RealX + M
-%% 0 = K * Xmin + M
-%% Width-1= K * Xmax + M
- K=(1-Wt)/-R,
- M=Wt-1-K*Xmax,
- Xbegin = round(Left*K+M),
- draw_cols(Image, Xbegin, Ht, lists:reverse(Data),MI,ColorTable).
-
-draw_cols(Image, X, Ht, [H|T],MaxIter,ColorTable) ->
- draw_col(Image, X, 0, H,MaxIter,ColorTable),
- draw_cols(Image, X+1, Ht, T,MaxIter,ColorTable);
-draw_cols(_Image, _X, _, [],_MaxIter,_ColorTable) ->
- done.
-
-draw_col(_Image, _X,_Y,[{no_first_color,0}],_MaxIter,_ColorTable) ->
- done;
-draw_col(Image, X,Y,[{Color,1}|T],MaxIter,ColorTable) ->
- gs:config(Image,[{pix_val,{{X,Y},
- element(Color+1,ColorTable)}}]),
- draw_col(Image, X,Y+1,T,MaxIter,ColorTable);
-draw_col(Image, X,Y,[{Color,Height}|T],MaxIter,ColorTable) ->
- gs:config(Image,[{pix_val,{{{X,Y},{X+1,Y+Height}},
- element(Color+1,ColorTable)}}]),
- draw_col(Image, X,Y+Height,T,MaxIter,ColorTable).
-
-make_jobs(#state{width=W,height=H,range=R,
- xmax=Xmax,ymax=Ymax,maxiter=MI}) ->
- make_jobs(Xmax-R,Xmax,Ymax-R,Ymax,H,W,MI).
-
-make_jobs(Xmin,Xmax,Ymin,Ymax,Ht,Wt,MaxIter) ->
- NoJobs = Wt/?JOBWIDTH, % Each job is ?JOBWIDTH pixel-col
- DX = (Xmax - Xmin)/NoJobs,
- make_jobs(DX,Xmin,Xmax,#job{ymin=Ymin,ymax=Ymax,height=Ht,width=Wt/NoJobs,
- maxiter=MaxIter},[]).
-
-make_jobs(DX,Left,Xmax,JobSkel,Res) when Left =< Xmax ->
- Right = Left + DX,
- Job = JobSkel#job{left=Left,right=Right},
- make_jobs(DX,Right,Xmax,JobSkel,[Job | Res]);
-make_jobs(_DX,_Left,_Xmax,_JobSkel,Res) -> Res.
-
-%%----------------------------------------------------------------------
-%% A small process that refreshes the screen now and then.
-%%----------------------------------------------------------------------
-refresher(Image) ->
- gs:config(Image,flush),
- timer:apply_after(8000,mandel,refresher,[Image]).
-
-%%-----------------------------------------------------------------
-%% This is the server start function.
-%%-----------------------------------------------------------------
-start_server([ClientNode]) ->
- register(mandel_server, self()),
- erlang:monitor_node(ClientNode, true),
- server_loop().
-
-server_loop() ->
- receive
- {mandel_job, {Pid, Job}} ->
- spawn_link(mandel, respond, [Pid, Job]),
- server_loop()
- end.
-
-respond(Pid, Job) ->
- Data = do_job(Job),
- Pid ! {calculation_done, {node(), Data}}.
-
-do_job(Job) ->
- calculate_area(Job).
-
-calculate_area(Job) ->
- #job{ymin=Ymin,ymax=Ymax,height=Ht,width=Wt,left=Xmin,right=Xmax}=Job,
- Job#job{data=x_loop(0,[],Wt,(Xmax-Xmin)/Wt,(Ymax-Ymin)/Ht,Xmin,Job)}.
-
-x_loop(IX,Res,Wt,Dx,Dy,X,Job) when IX < Wt ->
- #job{ymin=Ymin,height=Ht,maxiter=MaxIter}=Job,
- Cols = y_loop(0,Ht,[],MaxIter,Dy,X,Ymin,no_first_color,0),
- x_loop(IX+1,[Cols|Res],Wt,Dx,Dy,X+Dx,Job);
-x_loop(_,Res,_,_,_,_,_) ->
- Res.
-
-y_loop(IY,Ht,Res,MaxIter,Dy,X,Y,PrevColor,NprevColor) when IY < Ht ->
- Color = color_loop(1,MaxIter,0,0,0,0,X,Y),
- if
- Color == PrevColor ->
- y_loop(IY+1,Ht,Res,MaxIter,Dy,X,Y+Dy,PrevColor,NprevColor+1);
- true ->
- y_loop(IY+1,Ht,[{PrevColor,NprevColor}|Res],MaxIter,
- Dy,X,Y+Dy,Color,1)
- end;
-
-y_loop(_,_,Res,_,_,_,_,PC,N) ->
- [{PC,N}|Res].
-
-color_loop(Color,MaxIter,Za,Zb,Za2,Zb2,X,Y)
- when Za2 + Zb2 < 4, Color < MaxIter->
- Ztmp = Za2 - Zb2 + X,
- ZbN = 2 * Za * Zb + Y,
- color_loop(Color+1,MaxIter,Ztmp,ZbN,Ztmp * Ztmp,ZbN * ZbN,X,Y);
-color_loop(MaxIter,MaxIter,_Za,_Zb,_Za2,_Zb2,_X,_Y) ->
- 0; % black
-color_loop(Color,_,_,_,_,_,_,_) ->
- Color.
-
-%%----------------------------------------------------------------------
-%% The "colormodel".
-%%----------------------------------------------------------------------
-make_color_table(MaxColors) ->
- list_to_tuple([{0,0,0}|colors(MaxColors)]).
-
-colors(Ncolors) ->
- {A,B,C}=erlang:now(),
- random:seed(A,B,C),
- Colors = random_colors(Ncolors),
- Colors2 = best_insert([hd(Colors)],tl(Colors)),
- Colors2.
-
-random_colors(0) -> [];
-random_colors(N) ->
- R = random:uniform(256)-1,
- G = random:uniform(256)-1,
- B = random:uniform(256)-1,
- [{R,G,B}|random_colors(N-1)].
-
-best_insert(Sorted,[RGB|Unsorted]) ->
- best_insert(insert_at(best_pos(RGB,Sorted),RGB,Sorted),Unsorted);
-best_insert(Sorted,[]) -> Sorted.
-
-insert_at(1,Elem,L) -> [Elem|L];
-insert_at(N,Elem,[H|T]) -> [H|insert_at(N-1,Elem,T)].
-
-best_pos(RGB, Sorted) ->
- D = distances(RGB,Sorted),
- pos_for_smallest_distance(D,1,1000,-1).
-
-pos_for_smallest_distance([],_CurPos,_SmallestDist,Pos) -> Pos;
-pos_for_smallest_distance([Dist|T],CurPos,SmallDist,_Pos)
- when Dist < SmallDist ->
- pos_for_smallest_distance(T,CurPos+1,Dist,CurPos);
-pos_for_smallest_distance([_|T],CurPos,Smallest,Pos) ->
- pos_for_smallest_distance(T,CurPos+1,Smallest,Pos).
-
-distances(_RGB,[]) ->
- [];
-distances({R,G,B},[{R2,G2,B2}|T]) ->
- [lists:max([abs(R-R2),abs(G-G2),abs(B-B2)])|distances({R,G,B},T)].
-
-get_option(Option, Options, Default) ->
- case gs:assq(Option, Options) of
- {value, Val} -> Val;
- false -> Default
- end.
diff --git a/lib/gs/contribs/mandel/mandel.gif b/lib/gs/contribs/mandel/mandel.gif
deleted file mode 100644
index 49ed1985cb..0000000000
--- a/lib/gs/contribs/mandel/mandel.gif
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/mandel/mandel.html b/lib/gs/contribs/mandel/mandel.html
deleted file mode 100644
index f69cfa3c6a..0000000000
--- a/lib/gs/contribs/mandel/mandel.html
+++ /dev/null
@@ -1,74 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
-<!--
- ``Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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$
--->
-<HTML>
-<HEAD>
- <TITLE></TITLE>
- <META NAME="GENERATOR" CONTENT="Mozilla/3.01Gold (X11; I; SunOS 5.5.1 sun4m) [Netscape]">
-</HEAD>
-<BODY>
-
-<H1>Distributed Mandelbrot program</H1>
-
-<P>Originally written i C++/rpc/lwp/interviews by Klas Eriksson.(1200 lines)
-<BR>
-Rewritten in Erlang by Klas Eriksson and Martin Bj&ouml;rklund. </P>
-
-<P><A HREF="http://www.bush.edu/~nick/nick.html">What is the Mandelbrot
-function?</A> </P>
-
-<H2>A small manual</H2>
-
-<UL>
-<LI>Try starting erlang in distributed mode. The mandel program will use<BR>
-all connected nodes for mandel calculations!</LI>
-
-<LI>Resizing the window will restart the calculation.</LI>
-
-<LI>Press left mouse button to zoom.</LI>
-</UL>
-
-<P><TT>mandel:start(list of Option)</TT> can be used to give the program
-different options.</P>
-
-<P><BR>
-Available options are:</P>
-
-<UL>
-<LI>{xmax,float()}</LI>
-
-<LI>{ymax,float()}</LI>
-
-<LI>{range,float()}|</LI>
-
-<LI>{maxiter,integer()}</LI>
-
-<LI>{window,integer()}</LI>
-
-<LI>{zoomstep,float()}</LI>
-
-<LI>{hosts,(list of string())|all_found_nodes}</LI>
-</UL>
-
-<P><BR>
-</P>
-
-</BODY>
-</HTML>
diff --git a/lib/gs/contribs/mandel/mandel.tool b/lib/gs/contribs/mandel/mandel.tool
deleted file mode 100644
index b59941268e..0000000000
--- a/lib/gs/contribs/mandel/mandel.tool
+++ /dev/null
@@ -1,6 +0,0 @@
-{version,"0.1"}.
-{{tool,"Mandel"},
- {start,{mandel,start,[]}},
- {icon,"mandel.gif"},
- {message,"Mandelbrot"},
- {html,"../mandel/mandel.html"}}.
diff --git a/lib/gs/contribs/othello/Makefile b/lib/gs/contribs/othello/Makefile
deleted file mode 100644
index 8a66e17ec5..0000000000
--- a/lib/gs/contribs/othello/Makefile
+++ /dev/null
@@ -1,101 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2012. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(GS_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= \
- othello \
- othello_adt \
- othello_board
-
-HRL_FILES=
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES)
-
-TOOLNAME = othello
-
-EXTRA_FILES=
-TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif
-TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%)
-BITMAPS= priv/marker.bm priv/square.bm
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_COMPILE_FLAGS +=
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-debug opt: $(TARGET_FILES)
-
-docs:
-
-clean:
- rm -f $(TARGET_FILES)
- rm -f core
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-
-$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif
- $(gen_verbose)rm -f $@
- $(V_at)cp $(TOOLNAME).gif $@
-
-$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool
- $(gen_verbose)rm -f $@
- $(V_at)cp $(TOOLNAME).tool $@
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/othello"
- $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/othello"
- $(INSTALL_DIR) "$(RELSYSDIR)/othello/priv"
- $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/othello/priv"
-
-release_docs_spec:
-
diff --git a/lib/gs/contribs/othello/othello.erl b/lib/gs/contribs/othello/othello.erl
deleted file mode 100644
index c6ad0a76ec..0000000000
--- a/lib/gs/contribs/othello/othello.erl
+++ /dev/null
@@ -1,237 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(othello).
--export([start/0,new_game/4,start1/5]).
-
-
-
-%%----------------------------------------------------------------------
-%% The Othello program now uses the gs graphical package instead of the
-%% pxw package. See module othello_board for details
-%%
-%%----------------------------------------------------------------------
-
-
-start() -> othello_board:start().
-
-new_game(Computer,Player,Depth,Init) ->
- spawn_link(othello,start1,[self(),Computer,Player,Depth,Init]).
-
-start1(Win,Computer,Player,Depth,Init) ->
- Board = othello_adt:new(t),
- random:seed(),
- init_display(Board,Win,Init),
- play(Computer,Player,Board,Depth,Win,1).
-
-play(Computer,Player,Board,Depth,Win,NoDs) ->
- tell_win(Win,Computer,Player),
- case catch continue(Player,Board) of
- {game_over,Result} ->
- game_over(Board,Player,Result,Win);
- {omit_draw,Player} ->
- omit(Player,Win),
- play(Computer,swap(Player),Board,Depth,Win,NoDs);
- ok ->
- Draw = choose_draw(Computer,Player,Board,Depth,Win,NoDs),
- Win ! {self(),draw,Draw},
- Board1 = othello_adt:set(Draw,Player,Board),
- display(Board1,Board,Win),
- play(Computer,swap(Player),Board1,Depth,Win,NoDs+1)
- end.
-
-continue(Player,Board) ->
- Draws = game_over(Player,Board),
- not_allowed(Draws,Player),
- ok.
-
-choose_draw(Computer,Computer,Board,Depth,_Win,NoDs) -> % Depth > 0 !!
- {Draw,_Value} = alpha_beta(Depth,Board,-11000,11000,Computer,NoDs),
-% io:format('Choosen draw is {~w,~w} : (~w)~n',
-% [othello_adt:col(Draw),othello_adt:row(Draw),Value]),
-% io:format('=====================~n',[]),
- Draw;
-choose_draw(Computer,Player,Board,Depth,Win,NoDs) ->
- receive
- {Win,position,Draw} ->
- flush(Win),
- case othello_adt:is_draw(Draw,Player,Board) of
- false ->
- Win ! {self(),illegal_draw,Draw},
- choose_draw(Computer,Player,Board,Depth,Win,NoDs);
- true ->
- Draw
- end
- end.
-
-flush(Win) ->
- receive
- {Win,position,_} ->
- flush(Win)
- after 1 ->
- true
- end.
-
-tell_win(Win,Computer,Player) ->
- Win ! {self(),player,Computer,Player},
- receive
- {Win,go_on_play} -> true
- end.
-
-alpha_beta(0,Board,_,_,Player,_) ->
- {-1,othello_adt:evaluate_board(Player,Board)};
-alpha_beta(Depth,Board,Alpha,Beta,Player,NoDs) ->
- case compute(Player,Board,NoDs) of
- [] ->
- Player1 = swap(Player),
- case compute(Player1,Board,NoDs) of
- [] ->
- dead_lock(Board,Player);
- PosDraws1 ->
- choose(PosDraws1,Board,Depth-1,-Beta,-Alpha,-1,
- Player1,NoDs)
- end;
- PosDraws ->
- choose(PosDraws,Board,Depth-1,-Beta,-Alpha,-1,Player,NoDs)
-% A = choose(PosDraws,Board,Depth-1,-Beta,-Alpha,-1,Player,NoDs),
-% io:format('Alpha-Beta (~w) ==> ~w~n',[Depth,A]),
-% A
- end.
-
-choose([Draw|Draws],Board,Depth,Alpha,Beta,Record,Player,NoDs) ->
- Player1 = swap(Player),
- Board1 = othello_adt:set(Draw,Player,Board),
-% io:format('Alpha <~w> Beta <~w> ~n',[Alpha,Beta]),
- {_,Value} = alpha_beta(Depth,Board1,Alpha,Beta,Player1,NoDs+1),
- Value1 = -Value,
- cutoff(Draw,Value1,Depth,Alpha,Beta,Draws,Board,Record,Player,NoDs);
-choose([],_,_,Alpha,_,Draw,_,_) ->
- {Draw,Alpha}.
-
-cutoff(Draw,Value,_,_,Beta,_,_,_,_,_) when Value >= Beta ->
- {Draw,Value};
-cutoff(Draw,Value,Depth,Alpha,Beta,Draws,Board,_,Player,NoDs)
- when Alpha < Value, Value < Beta ->
- choose(Draws,Board,Depth,Value,Beta,Draw,Player,NoDs);
-cutoff(Draw,Value,Depth,Alpha,Beta,Draws,Board,Record,Player,NoDs)
- when Value == Alpha, NoDs < 13 ->
- choose(Draws,Board,Depth,Alpha,Beta,random_choice(Draw,Record),
- Player,NoDs);
-cutoff(_Draw,Value,Depth,Alpha,Beta,Draws,Board,Record,Player,NoDs)
- when Value =< Alpha ->
- choose(Draws,Board,Depth,Alpha,Beta,Record,Player,NoDs).
-
-compute(Player,Board,NoOfDraws) when NoOfDraws < 13 ->
- case othello_adt:possible_draws(Player,Board,begin_play) of
- [] ->
- othello_adt:possible_draws(Player,Board,playing);
- Draws ->
- Draws
- end;
-compute(Player,Board,_) ->
- othello_adt:possible_draws(Player,Board,playing).
-
-%%----------------------------------------------------------
-%% Randomly choose between two draws with the same value.
-%%----------------------------------------------------------
-
-random_choice(Draw,Draw1) ->
- case random:uniform(2) of
- 1 ->
- Draw;
- 2 ->
- Draw1
- end.
-
-dead_lock(Board,Player) ->
- case win_or_loose(Board,Player) of
- 0 -> {-1,0};
- Value when Value > 0 -> {-1,10000};
- _ -> {-1,-10000}
- end.
-
-win_or_loose(Board,Player) ->
- Player1 = swap(Player),
- othello_adt:pieces(Player,Board) - othello_adt:pieces(Player1,Board).
-
-game_over(Player,Board) ->
- case othello_adt:possible_draws(Player,Board,playing) of
- [] ->
- Player1 = swap(Player),
- case othello_adt:possible_draws(Player1,Board,playing) of
- [] ->
- throw({game_over,{{Player,othello_adt:pieces(Player,Board)},
- {Player1,othello_adt:pieces(Player1,Board)}}});
- _ ->
- [] % Player`s Draws !!
- end;
- Draws ->
- Draws
- end.
-
-game_over(_Board,_Player,Result,Win) ->
- Win ! {self(),game_over,white_res(Result),black_res(Result)}.
-
-white_res({{white,Res},_}) -> Res;
-white_res({_,{white,Res}}) -> Res.
-
-black_res({{black,Res},_}) -> Res;
-black_res({_,{black,Res}}) -> Res.
-
-not_allowed([],Player) ->
- throw({omit_draw, Player});
-not_allowed(_,_Player) ->
- ok.
-
-omit(Player,Win) ->
- Win ! {self(),omit_draw,Player},
- receive
- {Win,continue} ->
- ok
- end.
-
-init_display(_Board,_Win,first_time) ->
- true;
-init_display(Board,Win,_) ->
- display(Board,Win).
-
-display(Board,Win) ->
- All = othello_adt:all_pos(Board),
- display1(All,Win),
- Win ! {self(),score,othello_adt:pieces(white,Board),
- othello_adt:pieces(black,Board)}.
-
-display(Board,OldB,Win) ->
- Diff = othello_adt:diff(Board,OldB),
- display1(Diff,Win),
- Win ! {self(),score,othello_adt:pieces(white,Board),
- othello_adt:pieces(black,Board)}.
-
-display1([{Pos,Colour}|Diff],Win) ->
- Win ! {self(),new_mark,Pos,Colour},
- display1(Diff,Win);
-display1(_,_) ->
- true.
-
-swap(white) -> black;
-swap(black) -> white.
-
-
diff --git a/lib/gs/contribs/othello/othello.gif b/lib/gs/contribs/othello/othello.gif
deleted file mode 100644
index 5970c50209..0000000000
--- a/lib/gs/contribs/othello/othello.gif
+++ /dev/null
Binary files differ
diff --git a/lib/gs/contribs/othello/othello.tool b/lib/gs/contribs/othello/othello.tool
deleted file mode 100644
index 47550a581d..0000000000
--- a/lib/gs/contribs/othello/othello.tool
+++ /dev/null
@@ -1,6 +0,0 @@
-{version,"0.1"}.
-{{tool,"Othello"},
- {start,{othello,start,[]}},
- {icon,"othello.gif"},
- {message,"Othello - The Game"},
- {html,"http://www.armory.com/~iioa/othguide.html"}}.
diff --git a/lib/gs/contribs/othello/othello_adt.erl b/lib/gs/contribs/othello/othello_adt.erl
deleted file mode 100644
index e69c1c4d72..0000000000
--- a/lib/gs/contribs/othello/othello_adt.erl
+++ /dev/null
@@ -1,540 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(othello_adt).
--compile(export_all).
-%%-------------------------------------------------------
-%% Use three main states for the strategy:
-%%
-%% BeginPlay: Stay in the inner square as long as possible.
-%% Use the possible_draws/3.
-%%
-%% MiddlePlay: Try to choose stable markers (?)
-%% Use stable/3
-%%
-%% EndPlay: Try to flip as many markers as possible
-%%
-%% The transition from Begin to Middle is obvious. From Middle
-%% to End however, is can be discussed.
-%%-------------------------------------------------------
-
-test(N,B) ->
- X=new(B),
- statistics(wall_clock),
- test0(N,X),
- {_,T} = statistics(wall_clock),
- {time_was,T/N}.
-
-
-test0(0,_) -> true;
-test0(N,X) ->
- possible_draws(black,X,begin_play),
- test0(N-1,X).
-
-%%-------------------------------------------------------
-%% new/1 - returns a new board
-%%
-%% Uses a tuple for storing the board
-%%-------------------------------------------------------
-
-new(B) ->
- Board = mk_board(B),
- {ordsets:from_list([18,19,20,21,26,29,34,37,42,43,44,45]),Board}.
-
-mk_board(t) ->
- Tup = list_to_tuple(gen_list(64,grey)),
- Tup1 = setelement(28+1, Tup, white),
- Tup2 = setelement(35+1, Tup1, white),
- Tup3 = setelement(27+1, Tup2, black),
- gen_score_board(),
- setelement(36+1, Tup3, black).
-
-gen_list(0,_) -> [];
-gen_list(I,Def) -> [Def|gen_list(I-1,Def)].
-
-gen_score_board() -> put(score,list_to_tuple(gen_list(64,0))).
-
-%%-------------------------------------------------------
-%% pos(Col,Row) - returns a position describing column
-%% and row.
-%% Col and Row have the range 1 - 8.
-%%-------------------------------------------------------
-
-pos(Col,Row) -> ((Row - 1) bsl 3) + (Col - 1).
-
-%%-------------------------------------------------------
-%% col(Pos) - returns the column of the Pos position
-%%-------------------------------------------------------
-
-col(Pos) -> (Pos band 7) + 1.
-
-%%-------------------------------------------------------
-%% row(Pos) - returns the row of the Pos position
-%%-------------------------------------------------------
-
-row(Pos) -> (Pos bsr 3) + 1.
-
-%%-------------------------------------------------------
-%% is_draw(Pos,Colour,Board) - returns true if Pos is a
-%% correct draw.
-%%-------------------------------------------------------
-
-is_draw(Pos,Colour,{Bset,Board}) ->
- case ordsets:is_element(Pos,Bset) of
- true ->
- case catch is_good(Colour,Pos,Board) of
- true ->
- true;
- _ ->
- false
- end;
- _ ->
- false
- end.
-
-%%-------------------------------------------------------
-%% set(Pos,Colour,Board) - returns an updated board
-%%-------------------------------------------------------
-
-set(Pos,Colour,{Bset,Board}) ->
- case ordsets:is_element(Pos,Bset) of
- true ->
- NewBoard = setelement(Pos+1,Board,Colour),
- Empty = empty_neighbour(Pos,NewBoard),
- NewBset = ordsets:union(Empty,ordsets:del_element(Pos,Bset)),
- turn(Colour,Pos,{NewBset,NewBoard});
- _ ->
- {error,invalid_position}
- end.
-
-empty_neighbour(Pos,Board) ->
- ordsets:from_list(empty_neighbour(Pos,Board,deltas())).
-
-empty_neighbour(_,_,[]) -> [];
-empty_neighbour(Pos,Board,[H|T]) ->
- case is_empty(Pos+H,dir(Pos,H),Board) of
- true -> [Pos+H|empty_neighbour(Pos,Board,T)];
- _ -> empty_neighbour(Pos,Board,T)
- end.
-
-is_empty(_,false,_) -> false;
-is_empty(X,_,_Board) when X<0 -> false;
-is_empty(X,_,_Board) when X>63 -> false;
-is_empty(X,_,Board) ->
- case element(X+1,Board) of
- grey -> true; % Empty
- _ -> false
- end.
-
-%%-------------------------------------------------------
-%% get(Pos,Board) - returns the contents in Pos
-%%-------------------------------------------------------
-
-get(Pos,{_Bset,Board}) -> element(Pos+1,Board).
-
-%%-------------------------------------------------------
-%% pieces(Colour,Board) - returns the number of Colour
-%% pieces.
-%%-------------------------------------------------------
-
-pieces(Colour,{_Bset,Board}) ->
- pieces(Colour,Board,0,0).
-
-pieces(Colour,Board,Pos,Count) when Pos < 64 ->
- case element(Pos+1,Board) of
- Colour ->
- pieces(Colour,Board,Pos+1,Count+1);
- _ ->
- pieces(Colour,Board,Pos+1,Count)
- end;
-pieces(_,_,_,Count) ->
- Count.
-
-%%-------------------------------------------------------
-%% possible_draws(Colour, Board, State)
-%%
-%% Returns a list of possible draws regarding the current
-%% strategy state.
-%%-------------------------------------------------------
-
-possible_draws(Colour,{Bset,Board},begin_play) ->
- Dset = ordsets:intersection(Bset,inner_square()),
- possible_draws_0(Colour,Dset,Board);
-possible_draws(Colour,{Bset,Board},_) ->
- possible_draws_0(Colour,Bset,Board).
-
-possible_draws(Colour,{Bset,Board}) ->
- possible_draws_0(Colour,Bset,Board).
-
-possible_draws_0(_,[],_) -> [];
-possible_draws_0(Colour,[H|T],Board) ->
- case catch is_good(Colour,H,Board) of
- true -> [H|possible_draws_0(Colour,T,Board)];
- false -> possible_draws_0(Colour,T,Board)
- end.
-
-
-%%-------------------------------------------------------
-%% evaluate_board(Colour,Board) - returns the value of
-%% the board from Colours
-%% point of view.
-%%-------------------------------------------------------
-
-evaluate_board(Colour,{_Bset,Board}) ->
- Score = get(score), % Initialized (zeroed) score board !!
- Colour1 = swap(Colour),
- Score1 = eval_board(Colour,Colour1,Score,Board,0),
- Score2 = cnt_corner(0,Score1,Board,Colour,Colour1),
- Score3 = cnt_corner(7,Score2,Board,Colour,Colour1),
- Score4 = cnt_corner(56,Score3,Board,Colour,Colour1),
- Score5 = cnt_corner(63,Score4,Board,Colour,Colour1),
- count(Score5,0).
-% A = count(Score5,0),
-% io:format('Score = ~w~n',[A]),
-% A.
-
-eval_board(MyCol,OtCol,Score,Board,Pos) when Pos < 64 ->
- case element(Pos+1,Board) of
- MyCol ->
- Score1 = setelement(Pos+1,Score,score(Pos)),
- eval_board(MyCol,OtCol,Score1,Board,Pos+1);
- OtCol ->
- Score1 = setelement(Pos+1,Score,-score(Pos)),
- eval_board(MyCol,OtCol,Score1,Board,Pos+1);
- _ ->
- eval_board(MyCol,OtCol,Score,Board,Pos+1)
- end;
-eval_board(_,_,Score,_,_) ->
- Score.
-
-cnt_corner(Corner,Score,Board,MyCol,OtCol) ->
- case element(Corner+1,Board) of
- MyCol ->
- cnt_corn(Corner,setelement(Corner+1,Score,50),
- Board,50,MyCol);
- OtCol ->
- cnt_corn(Corner,setelement(Corner+1,Score,-50),
- Board,-50,OtCol);
- _ ->
- Score
- end.
-
-cnt_corn(0,Score,Board,Value,Colour) ->
- Score1 = cnt_corn(0,1,8,Score,Board,Value,Colour),
- cnt_corn(0,8,1,Score1,Board,Value,Colour);
-cnt_corn(7,Score,Board,Value,Colour) ->
- Score1 = cnt_corn(7,-1,8,Score,Board,Value,Colour),
- cnt_corn(7,8,-1,Score1,Board,Value,Colour);
-cnt_corn(56,Score,Board,Value,Colour) ->
- Score1 = cnt_corn(56,1,-8,Score,Board,Value,Colour),
- cnt_corn(56,-8,1,Score1,Board,Value,Colour);
-cnt_corn(63,Score,Board,Value,Colour) ->
- Score1 = cnt_corn(63,-1,-8,Score,Board,Value,Colour),
- cnt_corn(63,-8,-1,Score1,Board,Value,Colour).
-
-cnt_corn(Pos,Dir,LineDir,Score,Board,Value,Colour) ->
- case dir(Pos,Dir) of
- Dir ->
- NextEdge = Pos+Dir,
- case element(NextEdge+1,Board) of
- Colour ->
- Score1 = setelement(NextEdge+1,Score,Value),
- Score2 = cnt_line(NextEdge,LineDir,Score1,Board,
- Colour,Value),
- cnt_corn(NextEdge,Dir,LineDir,Score2,Board,Value,Colour);
- _ ->
- Score
- end;
- _ ->
- Score
- end.
-
-cnt_line(Pos,Dir,Score,Board,Colour,Value) ->
- case dir(Pos,Dir) of
- Dir ->
- OnLinePos = Pos+Dir,
- case element(OnLinePos+1,Board) of
- Colour ->
- Score1 = setelement(OnLinePos+1,Score,Value),
- cnt_line(OnLinePos,Dir,Score1,Board,Colour,Value);
- _ ->
- Score
- end;
- _ ->
- Score
- end.
-
-count(Score,Pos) when Pos < 64 ->
- element(Pos+1,Score) + count(Score,Pos+1);
-count(_,_) ->
- 0.
-
-swap(white) -> black;
-swap(black) -> white.
-
-%%-------------------------------------------------------
-%% stable(Colour,Pos,Board) - returns a value 0-8
-%%
-%% A high value is regarded as more stable than a lower one.
-%% The stability means how many "friendly" neighbours there
-%% are, i.e markers of the same colour. Neighbours positions
-%% outside the board are regarded as friendly.
-%%-------------------------------------------------------
-
-stable(Colour,Pos,{_,Board}) ->
- stable(deltas(),Colour,Pos,Board).
-
-stable([],_,_,_) -> 0;
-stable([H|T],Colour,Pos,Board) ->
- stable_val(Colour,Pos,H,Board) + stable(T,Colour,Pos,Board).
-
-stable_val(_,H,D,_) when H+D<0 -> 1;
-stable_val(_,H,D,_) when H+D>63 -> 1;
-stable_val(black,H,D,Board) ->
- case element((H+D)+1,Board) of
- black -> 1;
- _ -> 0
- end;
-stable_val(white,H,D,Board) ->
- case element((H+D)+1,Board) of
- white -> 1;
- _ -> 0
- end.
-
-%%-------------------------------------------------------
-%% diff(Board,OldBoard) - return a list of the positions
-%% with changed pieces.
-%% [{Pos1,Colour1},...]
-%%-------------------------------------------------------
-
-diff(Board,OldBoard) -> diff(0,Board,OldBoard).
-
-diff(Pos,Board,OldBoard) when Pos < 64 ->
- OldP = get(Pos,OldBoard),
- case get(Pos,Board) of
- OldP ->
- diff(Pos+1,Board,OldBoard);
- NewP ->
- [{Pos,NewP}|diff(Pos+1,Board,OldBoard)]
- end;
-diff(_,_,_) ->
- [].
-
-%%-------------------------------------------------------
-%% all_pos(Board) - return a list of the positions colour.
-%% [{Pos1,Colour1},...]
-%%-------------------------------------------------------
-
-all_pos(Board) -> all_pos(0,Board).
-
-all_pos(Pos,Board) when Pos < 64 ->
- [{Pos,get(Pos,Board)}|all_pos(Pos+1,Board)];
-all_pos(_,_) ->
- [].
-
-%%-------------------------------------------------------
-%% Internal stuff
-%%-------------------------------------------------------
-
-deltas() -> [9,8,7,1,-1,-7,-8,-9].
-
-inner_square() ->
- [18,19,20,21,26,27,28,29,34,35,36,37,42,43,44,45]. % Is already an ordset
- % Save list traversing.
-% ordsets:list_to_set([18,19,20,21,26,27,28,29,34,35,36,37,42,43,44,45]).
-
-inv(black) -> white;
-inv(white) -> black.
-
-is_good(Colour,H,Board) ->
- is_good_0(Colour,H,dir(H,-9),Board),
- is_good_0(Colour,H,dir(H,-8),Board),
- is_good_0(Colour,H,dir(H,-7),Board),
- is_good_0(Colour,H,dir(H,-1),Board),
- is_good_0(Colour,H,dir(H,1),Board),
- is_good_0(Colour,H,dir(H,7),Board),
- is_good_0(Colour,H,dir(H,8),Board),
- is_good_0(Colour,H,dir(H,9),Board),
- false.
-
-is_good_0(_,_,false,_) -> false;
-is_good_0(_,H,D,_) when is_integer(H), is_integer(D), H+D<0 -> false;
-is_good_0(_,H,D,_) when is_integer(H), is_integer(D), H+D>63 -> false;
-is_good_0(black,H,D,Board) when is_integer(H), is_integer(D) ->
- case element((H+D)+1,Board) of
- white -> is_good_1(black,H+D,dir(H+D,D),Board);
- _ -> false
- end;
-is_good_0(white,H,D,Board) when is_integer(H), is_integer(D) ->
- case element((H+D)+1,Board) of
- black -> is_good_1(white,H+D,dir(H+D,D),Board);
- _ -> false
- end.
-
-is_good_1(_,_,false,_) -> false;
-is_good_1(_,H,D,_) when is_integer(H), is_integer(D), H+D<0 -> false;
-is_good_1(_,H,D,_) when is_integer(H), is_integer(D), H+D>63 -> false;
-is_good_1(black,H,D,Board) when is_integer(H), is_integer(D) ->
- case element((H+D)+1,Board) of
- white -> is_good_1(black,H+D,dir(H+D,D),Board);
- black -> throw(true);
- _ -> false
- end;
-is_good_1(white,H,D,Board) when is_integer(H), is_integer(D) ->
- case element((H+D)+1,Board) of
- black -> is_good_1(white,H+D,dir(H+D,D),Board);
- white -> throw(true);
- _ -> false
- end.
-
-%%-------------------------------------------------------
-%% turn(Colour,Draw,Board) - returns an updated board
-%% turn all possible pieces
-%% on the board
-%% Neighbours are not changed !!
-%%-------------------------------------------------------
-
-turn(Colour,Draw,{Bset,Board}) ->
- {Bset,turn(Colour,Draw,-9,
- turn(Colour,Draw,-8,
- turn(Colour,Draw,-7,
- turn(Colour,Draw,-1,
- turn(Colour,Draw,1,
- turn(Colour,Draw,7,
- turn(Colour,Draw,8,
- turn(Colour,Draw,9,Board))))))))}.
-
-turn(Colour,H,D,Board) ->
- case catch is_good_0(Colour,H,dir(H,D),Board) of
- true ->
- turn_0(Colour,H,D,Board);
- false ->
- Board
- end.
-
-turn_0(_,H,D,B) when is_integer(H), is_integer(D), H+D<0 -> B;
-turn_0(_,H,D,B) when is_integer(H), is_integer(D), H+D>63 -> B;
-turn_0(black,H,D,Board) when is_integer(H), is_integer(D) ->
- E = H+D,
- case element(E+1,Board) of
- white -> turn_0(black,H+D,D,swap(black,E,Board));
- _ -> Board
- end;
-turn_0(white,H,D,Board) when is_integer(H), is_integer(D) ->
- E = H+D,
- case element(E+1,Board) of
- black -> turn_0(white,H+D,D,swap(white,E,Board));
- _ -> Board
- end.
-
-%%-------------------------------------------------------
-%% swap(Colour,Pos,Board) - returns an updated board
-%% turn a piece on the board
-%% Neighbours are not changed !!
-%%-------------------------------------------------------
-
-swap(Colour,Pos,Board) when is_integer(Pos) ->
- setelement(Pos+1,Board,Colour).
-
-score(Pos) -> score1({col(Pos),row(Pos)}).
-
-score1({Column,1}) when Column >= 3, Column =< 6 -> 20;
-score1({Column,8}) when Column >= 3, Column =< 6 -> 20;
-score1({1,Line}) when Line >= 3, Line =< 6 -> 20;
-score1({8,Line}) when Line >= 3, Line =< 6 -> 20;
-score1({Column,2}) when Column >= 3, Column =< 6 -> -7;
-score1({Column,7}) when Column >= 3, Column =< 6 -> -7;
-score1({2,Line}) when Line >= 3, Line =< 6 -> -7;
-score1({7,Line}) when Line >= 3, Line =< 6 -> -7;
-score1({Column,Line}) when Column >= 3, Column =< 6,
- Line >= 3, Line =< 6 -> 1;
-score1({1,1}) -> 100;
-score1({1,8}) -> 100;
-score1({8,1}) -> 100;
-score1({8,8}) -> 100;
-score1({2,1}) -> -30;
-score1({7,1}) -> -30;
-score1({1,2}) -> -30;
-score1({8,2}) -> -30;
-score1({1,7}) -> -30;
-score1({8,7}) -> -30;
-score1({2,8}) -> -30;
-score1({7,8}) -> -30;
-score1({2,2}) -> -50;
-score1({7,2}) -> -50;
-score1({2,7}) -> -50;
-score1({7,7}) -> -50.
-
-%%-------------------------------------------------------
-%% dir(Pos,Dir) - return Dir if allowed direction at Pos.
-%% else return false.
-%%-------------------------------------------------------
-
-dir(0,1) -> 1; % {1,1}
-dir(0,8) -> 8;
-dir(0,9) -> 9;
-dir(0,_) -> false;
-
-dir(7,-1) -> -1; % {8,1}
-dir(7,7) -> 7;
-dir(7,8) -> 8;
-dir(7,_) -> false;
-
-dir(56,-8) -> -8; % {1,8}
-dir(56,-7) -> -7;
-dir(56,1) -> 1;
-dir(56,_) -> false;
-
-dir(63,-9) -> -9; % {8,8}
-dir(63,-8) -> -8;
-dir(63,-1) -> -1;
-dir(63,_) -> false;
-
-dir(Pos,-1) when (Pos bsr 3) == 0 -> -1; % {_,1}
-dir(Pos,1) when (Pos bsr 3) == 0 -> 1;
-dir(Pos,7) when (Pos bsr 3) == 0 -> 7;
-dir(Pos,8) when (Pos bsr 3) == 0 -> 8;
-dir(Pos,9) when (Pos bsr 3) == 0 -> 9;
-dir(Pos,_) when (Pos bsr 3) == 0 -> false;
-
-dir(Pos,-9) when (Pos bsr 3) == 7 -> -9; % {_,8}
-dir(Pos,-8) when (Pos bsr 3) == 7 -> -8;
-dir(Pos,-7) when (Pos bsr 3) == 7 -> -7;
-dir(Pos,-1) when (Pos bsr 3) == 7 -> -1;
-dir(Pos,1) when (Pos bsr 3) == 7 -> 1;
-dir(Pos,_) when (Pos bsr 3) == 7 -> false;
-
-dir(Pos,-8) when (Pos band 7) == 0 -> -8; % {1,_}
-dir(Pos,-7) when (Pos band 7) == 0 -> -7;
-dir(Pos,1) when (Pos band 7) == 0 -> 1;
-dir(Pos,8) when (Pos band 7) == 0 -> 8;
-dir(Pos,9) when (Pos band 7) == 0 -> 9;
-dir(Pos,_) when (Pos band 7) == 0 -> false;
-
-dir(Pos,-9) when (Pos band 7) == 7 -> -9; % {8,_}
-dir(Pos,-8) when (Pos band 7) == 7 -> -8;
-dir(Pos,-1) when (Pos band 7) == 7 -> -1;
-dir(Pos,7) when (Pos band 7) == 7 -> 7;
-dir(Pos,8) when (Pos band 7) == 7 -> 8;
-dir(Pos,_) when (Pos band 7) == 7 -> false;
-
-dir(_Pos,Dir) -> Dir.
-
diff --git a/lib/gs/contribs/othello/othello_board.erl b/lib/gs/contribs/othello/othello_board.erl
deleted file mode 100644
index cc055b1fa1..0000000000
--- a/lib/gs/contribs/othello/othello_board.erl
+++ /dev/null
@@ -1,649 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(othello_board).
--compile([{nowarn_deprecated_function,{gs,config,2}},
- {nowarn_deprecated_function,{gs,create,3}},
- {nowarn_deprecated_function,{gs,create,4}},
- {nowarn_deprecated_function,{gs,destroy,1}},
- {nowarn_deprecated_function,{gs,start,0}}]).
-
--export([start/0,stop/0,init/0]).
-
-
-%%----------------------------------------------------------------------
-%% The Othello program now uses the gs graphical package instead of the
-%% pxw package.
-%%
-%% Differences are, explanation why and source of change in parenthesis:
-%%
-%% - Buttons looks different (gs feature)
-%% - The black box around "Black to draw" have been removed. (me)
-%% - The Colour and Level menues have been moved directly down to the
-%% 'Status' box. (usability update, my addition)
-%% - The mouse pointer does not change into a watch when the computer
-%% is thinking (not supported in gs)
-%% - Buttons does not flash when being beeped. (not supported in gs)
-%%
-%%
-%% /Peter
-%%
-%%----------------------------------------------------------------------
-
-
--define(BGCOL,forestgreen).
-
-start() ->
- spawn(othello_board,init,[]).
-
-stop() ->
- ok.
-
-%% This is not an application so we don't have their way of knowing
-%% a private data directory where the GIF files are located (this directory).
-%% We can find GS and makes it relative from there /kgb
-
--define(BitmapPath,"../contribs/othello/priv").
-
-setup_path() ->
- GsPrivDir = code:priv_dir(gs),
- Path = filename:join(GsPrivDir,?BitmapPath),
- put(path,Path).
-
-path() -> get(path).
-
-
-
-%%
-%% The button area are the Quit, Rules buttons at the top of the window.
-%% The Status area is the black and white scores level and colour etc
-%% inbetween the buttons and the othello board.
-%% The board is the 8x8 board where othello battles are fought.
-%%
-init() ->
- process_flag(trap_exit,true),
- setup_path(),
- S = gs:start(),
- put(windowroot,S), % Ugly global store
-
- %% Shell coordinates
- W = 496,
- H = 636,
-
- %% Fix top window
- Shell = gs:create(window, S, [{title,"Othello"},
- {width, W},{height, H}]),
-
-
- %% Setup window contents
-
- setup_buttons(Shell,0,0,W,40), % Fix Menubar
- setup_status_box(Shell,0,40,W,100), % Fix Status area
- setup_board(Shell,0,140,496,496), % Combat board
-
- GamePid = othello:new_game(white,black,1,first_time),
-
- %% Default settings
- Options = {white,black,1},
- %%Wids = {Status,B,W,Dr,Le,Co},
- Wids = {change,this,at,later,stage,ponto},
- write_options(Options,Wids),
-
- gs:config(Shell, {map, true}), %Make win visible
-
- loop(computer,GamePid,Shell,Wids,Options).
-
-
-
-
-
-
-loop(User,GamePid,Shell,Wids,Options) ->
- receive
- {gs,ButtId, click,_ButtId1,[Button]} ->
- GamePid1 = but_pressed(Button,ButtId,User,GamePid,Shell,
- Wids,Options),
- loop(User,GamePid1,Shell,Wids,Options);
-
- {gs,_, click,_,[MenuItem,_MenuIndex]} ->
- Ops = menu_selected(MenuItem,User,GamePid,Wids,Options),
- loop(User,GamePid,Shell,Wids,Ops);
-
- {'EXIT',GamePid,_} ->
- loop(User,null,Shell,Wids,Options);
-
- {'EXIT',_,_} ->
- loop(User,GamePid,Shell,Wids,Options);
-
- GameMsg ->
- game_msg(GameMsg,User,GamePid,Shell,Wids,Options)
- end.
-
-but_pressed("Quit",_ButtId,_User,_GamePid,_Shell,_Wids,_Op) ->
- stop(),
- exit(quit);
-but_pressed("Rules",_ButtId,_User,GamePid,_Shell,_Wids,_Op) ->
- io:format("No rules, do as you wish~n",[]),
- GamePid;
-but_pressed("Help",_ButtId,_User,GamePid,_Shell,_Wids,_Op) ->
- io:format("Othello game~n",[]),
- io:format("------------~n",[]),
- io:format(" Put markers by clicking in squares~n",[]),
- io:format(" Change level by clicking on it~n",[]),
- io:format(" Change colour by clicking on it~n",[]),
- io:format("~n",[]),
- GamePid;
-but_pressed("Newgame",_ButtId,_User,GamePid,_Shell,Wids,Options) ->
- new_game(GamePid,Wids,Options);
-but_pressed([],ButtId,User,GamePid,_Shell,_Wids,_Op)
- when is_pid(GamePid),User == player ->
- [C,R] = atom_to_list(ButtId),
- GamePid ! {self(),position,othello_adt:pos(C-96,translate(R-48))},
- GamePid;
-but_pressed([],ButtId,_User,GamePid,_Shell,_Wids,_Op) ->
- [C,R] = atom_to_list(ButtId),
- beep(othello_adt:pos(C-96,translate(R-48))),
- GamePid;
-but_pressed(Button,ButtId,_User,GamePid,_Shell,_Wids,_Op) ->
- io:format('Not implemented button pressed ~p, ~p!!!~n',[ButtId,Button]),
- GamePid.
-
-menu_selected("Black",_User,_GamePid,Wids,Options) ->
- Op0 = setelement(1,Options,white),
- Op1 = setelement(2,Op0,white),
- write_options(Op1,Wids),
- Op1;
-menu_selected("White",_User,_GamePid,Wids,Options) ->
- Op0 = setelement(1,Options,black),
- Op1 = setelement(2,Op0,black),
- write_options(Op1,Wids),
- Op1;
-menu_selected("Black (begin)",_User,_GamePid,Wids,Options) ->
- Op0 = setelement(1,Options,white),
- Op1 = setelement(2,Op0,black),
- write_options(Op1,Wids),
- Op1;
-menu_selected("White (begin)",_User,_GamePid,Wids,Options) ->
- Op0 = setelement(1,Options,black),
- Op1 = setelement(2,Op0,white),
- write_options(Op1,Wids),
- Op1;
-menu_selected("Beginner",_User,_GamePid,Wids,Options) ->
- Op1 = setelement(3,Options,1),
- write_options(Op1,Wids),
- Op1;
-menu_selected("Intermediate",_User,_GamePid,Wids,Options) ->
- Op1 = setelement(3,Options,2),
- write_options(Op1,Wids),
- Op1;
-menu_selected("Advanced",_User,_GamePid,Wids,Options) ->
- Op1 = setelement(3,Options,3),
- write_options(Op1,Wids),
- Op1;
-menu_selected("Expert",_User,_GamePid,Wids,Options) ->
- Op1 = setelement(3,Options,4),
- write_options(Op1,Wids),
- Op1;
-menu_selected(What,_User,_GamePid,_Wids,Options) ->
- io:format('Menu item not implemented <~s>~n',[What]),
- Options.
-
-game_msg(Msg,User,GamePid,Shell,Wids,Options) ->
- case Msg of
- {GamePid,new_mark,Pos,Colour} ->
- new_mark(Pos,Colour),
- loop(User,GamePid,Shell,Wids,Options);
-
- {GamePid,illegal_draw,Draw} ->
- beep(Draw),
- loop(User,GamePid,Shell,Wids,Options);
-
- {GamePid,player,Computer,Computer} ->
- show_player(element(1,Wids),Computer),
- cursor("watch"),
- GamePid ! {self(),go_on_play},
- loop(computer,GamePid,Shell,Wids,Options);
-
- {GamePid,player,_Computer,Player} ->
- show_player(element(1,Wids),Player),
- cursor("top_left_arrow"),
- GamePid ! {self(),go_on_play},
- loop(player,GamePid,Shell,Wids,Options);
-
- {GamePid,omit_draw,Player} ->
- omit_draw(GamePid,Player),
- loop(User,GamePid,Shell,Wids,Options);
-
- {GamePid,score,WhiteRes,BlackRes} ->
- write_score(Wids,WhiteRes,BlackRes),
- loop(User,GamePid,Shell,Wids,Options);
-
- {GamePid,draw,Draw} ->
- write_draw(Wids,Draw),
- loop(User,GamePid,Shell,Wids,Options);
-
- {GamePid,game_over,WhiteRes,BlackRes} ->
- game_over(WhiteRes,BlackRes),
- loop(User,GamePid,Shell,Wids,Options);
-
- What ->
- io:format('game_msg received: ~w~n',[What]),
- loop(User,GamePid,Shell,Wids,Options)
- end.
-
-
-new_game(GamePid,Wids,Options) when is_pid(GamePid) ->
- exit(GamePid,kill),
- new_game(Wids,Options);
-new_game(_,Wids,Options) ->
- new_game(Wids,Options).
-
-new_game(_Wids,Options) ->
- label("",lastdraw),
- Computer = element(1,Options),
- Start = element(2,Options),
- Depth = element(3,Options),
- othello:new_game(Computer,Start,Depth,restart).
-
-new_mark(Pos,Colour) ->
- Col = othello_adt:col(Pos),
- Row = othello_adt:row(Pos),
- Name = [Col+96,translate(Row)+48],
- Button = get(Name),
- butbit(Button,Colour).
-
-beep(Draw) ->
- Col = othello_adt:col(Draw),
- Row = othello_adt:row(Draw),
- Name = [Col+96,translate(Row)+48],
- Button = get(Name),
- bell(Button).
-
-show_player(_Status,white) ->
- label("White to draw",todraw);
-show_player(_Status,black) ->
- label("Black to draw",todraw).
-
-write_score(_Wids,WhiteRes,BlackRes) ->
- label(integer_to_list(BlackRes),bscore),
- label(integer_to_list(WhiteRes),wscore).
-
-write_draw(_Wids,Draw) ->
- Col = othello_adt:col(Draw),
- Row = othello_adt:row(Draw),
- label(lists:flatten(io_lib:format('{~w,~w}',[Col,Row])), lastdraw).
-
-write_options(Options,Wids) ->
- write_colour(Options,Wids),
- write_level(Options,Wids).
-
-write_colour(Options,Wids) ->
- write_colour(element(1,Options),element(2,Options),Wids).
-
-write_colour(black,white,_Wids) -> label("White (begin)",colour);
-write_colour(black,black,_Wids) -> label("White",colour);
-write_colour(white,black,_Wids) -> label("Black (begin)",colour);
-write_colour(white,white,_Wids) -> label("Black",colour).
-
-write_level(Options,_Wids) ->
- case element(3,Options) of
- 1 -> label("Beginner",level);
- 2 -> label("Intermediate",level);
- 3 -> label("Advanced",level);
- 4 -> label("Expert",level)
- end.
-
-cursor(_What) ->
- done.
-%cursor(What) -> cursor(get(),What).
-
-%cursor([{[C,R],Button}|Buts],What) ->
-% set_widget(Button,"cursor",What),
-% cursor(Buts,What);
-%cursor([_|Buts],What) ->
-% cursor(Buts,What);
-%cursor([],_) ->
-% true.
-
-translate(1) -> 8;
-translate(2) -> 7;
-translate(3) -> 6;
-translate(4) -> 5;
-translate(5) -> 4;
-translate(6) -> 3;
-translate(7) -> 2;
-translate(8) -> 1.
-
-bitmap(grey) -> bitmap_path("square.bm");
-bitmap(black) -> bitmap_path("marker.bm");
-bitmap(white) -> bitmap_path("marker.bm").
-
-bitmap_path(Bitmap) ->
- filename:join(path(),Bitmap).
-
-xy_position([[Letter,Digit],_,_]) ->
- LettPos = Letter - 97,
- X = LettPos*60 ,
- Y = (8 - list_to_integer([Digit])) * 60,
- {X+6,Y+6};
-xy_position(X) ->
- io:format("xy_position: ~w~n",[{error,X}]).
-
-
-board() ->
- [["a1",grey,nil],
- ["b1",grey,nil],
- ["c1",grey,nil],
- ["d1",grey,nil],
- ["e1",grey,nil],
- ["f1",grey,nil],
- ["g1",grey,nil],
- ["h1",grey,nil],
-
- ["a2",grey,nil],
- ["b2",grey,nil],
- ["c2",grey,nil],
- ["d2",grey,nil],
- ["e2",grey,nil],
- ["f2",grey,nil],
- ["g2",grey,nil],
- ["h2",grey,nil],
-
- ["a3",grey,nil],
- ["b3",grey,nil],
- ["c3",grey,nil],
- ["d3",grey,nil],
- ["e3",grey,nil],
- ["f3",grey,nil],
- ["g3",grey,nil],
- ["h3",grey,nil],
-
- ["a4",grey,nil],
- ["b4",grey,nil],
- ["c4",grey,nil],
- ["d4",white,nil],
- ["e4",black,nil],
- ["f4",grey,nil],
- ["g4",grey,nil],
- ["h4",grey,nil],
-
- ["a5",grey,nil],
- ["b5",grey,nil],
- ["c5",grey,nil],
- ["d5",black,nil],
- ["e5",white,nil],
- ["f5",grey,nil],
- ["g5",grey,nil],
- ["h5",grey,nil],
-
- ["a6",grey,nil],
- ["b6",grey,nil],
- ["c6",grey,nil],
- ["d6",grey,nil],
- ["e6",grey,nil],
- ["f6",grey,nil],
- ["g6",grey,nil],
- ["h6",grey,nil],
-
- ["a7",grey,nil],
- ["b7",grey,nil],
- ["c7",grey,nil],
- ["d7",grey,nil],
- ["e7",grey,nil],
- ["f7",grey,nil],
- ["g7",grey,nil],
- ["h7",grey,nil],
-
- ["a8",grey,nil],
- ["b8",grey,nil],
- ["c8",grey,nil],
- ["d8",grey,nil],
- ["e8",grey,nil],
- ["f8",grey,nil],
- ["g8",grey,nil],
- ["h8",grey,nil]].
-
-
-omit_draw(GamePid,Player) ->
-% %% Find mouse coords first
-% %% This was not possible in gs
-
- W = 200, H = 100, Root = get(windowroot),
- Box = gs:create(window, Root, [{title,"OMIT"}, {width, W},{height, H}]),
-
- mk_label_c(lists:flatten(io_lib:format('~w has to omit draw !',[Player])),
- Box, W, 10),
-
- mk_button_c("Ok", Box, W, H-40, 80, 30),
-
- gs:config(Box, {map, true}), %Make win visible
-
- receive
- {gs,_, click,_,["Ok"]} ->
- gs:destroy(Box),
- GamePid ! {self(),continue}
- end.
-
-game_over(WhiteRes,BlackRes) ->
-% %% Find mouse coords first
-% %% This was not possible in gs
-
- W = 200, H = 160,
- Root = get(windowroot),
- Box = gs:create(window, Root, [{title,"GAME OVER"},
- {width, W},{height, H}]),
-
- mk_label_c("GAME OVER", Box, W, 10),
-
- mk_label_c(lists:flatten(io_lib:format('White score: ~w',[WhiteRes])),
- Box,W,40),
- mk_label_c(lists:flatten(io_lib:format('Black score: ~w',[BlackRes])),
- Box,W,70),
-
- mk_button_c("Ok", Box, W, H-40, 80, 30),
-
- gs:config(Box, {map, true}), %Make win visible
-
- receive
- {gs,_, click,_,["Ok"]} ->
- gs:destroy(Box)
- end.
-
-
-
-%% ----------------------------------------------------------------
-%% Library functions.
-%% ----------------------------------------------------------------
-
-bell(Widget) ->
- %% gs does not support bells,
- Widget.
-
-label(Text,Label) ->
- gs:config(Label,[{label,{text,Text}}]).
-
-%% mk_label in centered version
-mk_label_c(Label,Parent,Width,Y) ->
- W = 8*length(Label),
- X = trunc((Width-W)/2),
- gs:create(label,Parent,[{width,W}, {height, 20}, {x,X}, {y,Y},
- {label, {text, Label}}]).
-
-
-
-
-setup_buttons(Shell,X,Y,W,H) ->
- ButBox = gs:create(frame, Shell,[{x,X}, {y,Y},{bg,white},
- {width,W}, {height,H}]),
- C = gs:create(canvas,ButBox,[{x,X}, {y,Y}, {width, W}, {height, H},
- {bg,white}]),
- gs:create(line, C, [{coords, [{0,H-1},{W,H-1}]}]),
-
-
- mk_button("Quit",ButBox, 10, 10, 70, 20),
- mk_button("Rules",ButBox, 80, 10, 70, 20),
- mk_button("Newgame",ButBox, 150, 10, 70, 20),
- mk_button("Help",ButBox, 220, 10, 70, 20),
-%% mk_button("Level",ButBox, 290, 10, 70, 20),
-
- done.
-
-
-
-
-
-%%----------------------------------------
-%% Sets up the middle window w. all the status info in.
-%% The labels are given names:
-%% bscore, wscore, lastdraw, todraw, level and colour to simplify
-%% their frequent setting
-%%
-setup_status_box(Shell,X,Y,W,H) ->
- F = gs:create(frame, Shell,[{x,X}, {y,Y},
- {width,W}, {height,H},{bg,white}]),
- C = gs:create(canvas,F,[{x,0}, {y,0}, {width, W}, {height, H},{bg,white}]),
- gs:create(line, C, [{coords, [{0,H-1},{W,H-1}]}]),
-
- %% Left side
- gs:create(label,F,[{align,w},{x,10}, {y,5}, {width, 100},
- {label,{text, "Black score:"}},{bg,white}]),
- gs:create(label,bscore,F,[{align,w},{x,110}, {y,5}, {width, 40},
- {label,{text, "2"}},{bg,white}]),
- gs:create(label,F,[{align,w},{x,10}, {y,35}, {width, 100},
- {label,{text, "White score:"}},{bg,white}]),
- gs:create(label,wscore,F,[{align,w},{x,110}, {y,35}, {width, 40},
- {label,{text, "2"}},{bg,white}]),
- gs:create(label,F,[{align,w},{x,10}, {y,65}, {width, 100},
- {label,{text, "Last draw:"}},{bg,white}]),
- gs:create(label,lastdraw,F,[{align,w},{x,110}, {y,65}, {width, 40},
- {label,{text, ""}},{bg,white}]),
-
-
- %% Right side
- X2 = trunc(W/2)+10,
- gs:create(label,todraw,F,[{align,w},{x,X2}, {y,5}, {width, 100},
- {label,{text, "Black to draw:"}},{bg,white}]),
-
- gs:create(label,F,[{align,w},{x,X2}, {y,35}, {width, 80},
- {label,{text, "Level:"}},{bg,white}]),
- setup_level_menu(F,X2+80,35),
-
-%% gs:create(label,level,F,[{align,w},{x,X2+80}, {y,35}, {width, 130},
-%% {label,{text, "Intermediate"}},{bg,white}]),
- gs:create(label,F,[{align,w},{x,X2}, {y,65}, {width, 80},
- {label,{text, "Colour:"}},{bg,white}]),
- setup_col_menu(F,X2+80,65),
-
-%% gs:create(label,colour,F,[{align,w},{x,X2+80}, {y,65}, {width, 120},
-%% {label,{text, "black (begin)"}},{bg,white}]),
-
- done.
-
-
-setup_col_menu(P,X,Y) ->
- MB = gs:create(menubutton,colour,P,
- [{x,X}, {y,Y}, {bw,3},
- %%{width,W}, {height,H},
- {align,w}, {bg,white},
- {relief, raised},
- {activefg,white}, {activebg,black},
- {label, {text,"Colours"}}]),
-
- M = gs:create(menu,MB,[]),
- gs:create(menuitem,M,[{label,{text,"Black (begin)"}}]),
- gs:create(menuitem,M,[{label,{text,"Black"}}]),
- gs:create(menuitem,M,[{label,{text,"White (begin)"}}]),
- gs:create(menuitem,M,[{label,{text,"White"}}]),
- done.
-
-setup_level_menu(P,X,Y) ->
- MB = gs:create(menubutton,level,P,
- [{x,X}, {y,Y},
- %%{width,W}, {height,H},
- {relief, raised},
- {activefg,white}, {activebg,black},
- {align,w}, {bg,white},
- {label, {text,"Colours"}}]),
-
- M = gs:create(menu,MB,[]),
- gs:create(menuitem,M,[{label,{text,"Beginner"}}]),
- gs:create(menuitem,M,[{label,{text,"Intermediate"}}]),
- gs:create(menuitem,M,[{label,{text,"Advanced"}}]),
- gs:create(menuitem,M,[{label,{text,"Expert"}}]),
- done.
-
-
-setup_board(Shell,X,Y,W,H) ->
- F = gs:create(frame, Shell,[{x,X}, {y,Y},
- {width,W}, {height,H},{bg,white}]),
- display_board(F).
-
-
-mk_button(Label, Parent, X, Y, W, H) ->
- gs:create(button,Parent,[{width,W}, {height, H}, {x,X}, {y,Y},
- {label, {text, Label}}, {bg,white},
- {activefg,white}, {activebg,black}]).
-
-%% Centers a button around Width
-mk_button_c(Label, Parent, Width, Y, W, H) ->
- X = trunc((Width-W)/2),
- gs:create(button,Parent,[{width,W}, {height, H}, {x,X}, {y,Y},
- {label, {text, Label}}, {bg,white}]).
-
-
-butbit(Button,Col) ->
- gs:config(Button,[
- {label,{image,bitmap(Col)}},
- {fg, Col},
- {activefg,Col},
- {label, {image, bitmap(Col)}}]),
- Button.
-
-mk_board_butt(Top,Name,X,Y,Col) ->
- B = gs:create(button,list_to_atom(Name), Top,
- [{x,X}, {y,Y}, {width,60}, {height,60},
- {padx,5},{pady,5},
- {relief,flat},
- {bg,?BGCOL}, {activebg,?BGCOL}]),
- butbit(B,Col),
- B.
-
-
-
-display_board(Top) ->
- Board = board(),
- display_board(Top,Board,1).
-
-display_board(_,_,65) -> true;
-display_board(Top,[H|T],Place) ->
- [Name,Colour,_] = H,
- {X,Y} = xy_position(H),
- Button = mk_board_butt(Top,Name,X,Y,Colour),
- %%Button = mk_button("",Name,Top,X,Y,60,60),
- put(Name,Button),
- %%Bitmap = bitmap(Colour),
- %%butbit(Button,Bitmap),
- %%set_widget(Button,"internalWidth","1"),
- %%set_widget(Button,"internalHeight","1"),
- %%borderWidth(2,Button),
- display_board(Top,T,Place+1).
-
-
diff --git a/lib/gs/contribs/othello/priv/marker.bm b/lib/gs/contribs/othello/priv/marker.bm
deleted file mode 100644
index fe7f3df820..0000000000
--- a/lib/gs/contribs/othello/priv/marker.bm
+++ /dev/null
@@ -1,43 +0,0 @@
-#define marker2_width 60
-#define marker2_height 60
-static unsigned char marker2_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x0f, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xc0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff,
- 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x0f, 0x00, 0x00,
- 0x00, 0x00, 0xff, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff,
- 0xff, 0x3f, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00,
- 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0xf8, 0xff, 0xff,
- 0xff, 0xff, 0x03, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x03, 0x00,
- 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x07, 0x00, 0x00, 0xfe, 0xff, 0xff,
- 0xff, 0xff, 0x0f, 0x00, 0x00, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x00,
- 0x00, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x00, 0x80, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0x3f, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x00,
- 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0x7f, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00,
- 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00, 0xe0, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00,
- 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00,
- 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00,
- 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00,
- 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7e, 0x00, 0xc0, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0x7f, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x7f, 0x00,
- 0x80, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x3f, 0x00, 0x80, 0xff, 0xff, 0xff,
- 0xff, 0x3f, 0x3f, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x3f, 0x00,
- 0x00, 0xff, 0xff, 0xff, 0xff, 0x9f, 0x1f, 0x00, 0x00, 0xff, 0xff, 0xff,
- 0xff, 0xcf, 0x1f, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xc7, 0x0f, 0x00,
- 0x00, 0xfc, 0xff, 0xff, 0xff, 0xe7, 0x07, 0x00, 0x00, 0xf8, 0xff, 0xff,
- 0x7f, 0xf1, 0x03, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xbf, 0xfc, 0x03, 0x00,
- 0x00, 0xf0, 0xff, 0xff, 0x59, 0xff, 0x01, 0x00, 0x00, 0xe0, 0xff, 0xff,
- 0xff, 0xff, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0x3f, 0x00, 0x00,
- 0x00, 0x00, 0xff, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff,
- 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x03, 0x00, 0x00,
- 0x00, 0x00, 0xc0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe,
- 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/lib/gs/contribs/othello/priv/square.bm b/lib/gs/contribs/othello/priv/square.bm
deleted file mode 100644
index 4e6880b330..0000000000
--- a/lib/gs/contribs/othello/priv/square.bm
+++ /dev/null
@@ -1,43 +0,0 @@
-#define square_width 60
-#define square_height 60
-static unsigned char square_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/lib/gs/test/Makefile b/lib/gs/test/Makefile
index 493770745f..067e1adbb6 100644
--- a/lib/gs/test/Makefile
+++ b/lib/gs/test/Makefile
@@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/gs_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/hipe/cerl/cerl_cconv.erl b/lib/hipe/cerl/cerl_cconv.erl
index 0fc28be5f3..ac9d01ab0e 100644
--- a/lib/hipe/cerl/cerl_cconv.erl
+++ b/lib/hipe/cerl/cerl_cconv.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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.
@@ -710,7 +710,7 @@ ren__new() ->
ren__add(Key, Value, Ren) ->
dict:store(Key, Value, Ren).
-ren__map(Key, Ren) ->
+ren__map(Key, Ren) ->
case dict:find(Key, Ren) of
{ok, Value} ->
Value;
@@ -722,11 +722,14 @@ ren__map(Key, Ren) ->
%% ---------------------------------------------------------------------
%% State
--record(state, {module :: module(), function :: {atom(), arity()},
- names, refs, defs = []}).
+-record(state, {module :: module(),
+ function :: {atom(), arity()} | 'undefined',
+ names = sets:new() :: sets:set(), %% XXX: refine
+ refs = dict:new() :: dict:dict(), %% XXX: refine
+ defs = []}).
s__new(Module) ->
- #state{module = Module, names = sets:new(), refs = dict:new()}.
+ #state{module = Module}.
s__add_function_name(Name, S) ->
S#state{names = sets:add_element(Name, S#state.names)}.
diff --git a/lib/hipe/cerl/cerl_hipeify.erl b/lib/hipe/cerl/cerl_hipeify.erl
index 8691e80cac..6611abd204 100644
--- a/lib/hipe/cerl/cerl_hipeify.erl
+++ b/lib/hipe/cerl/cerl_hipeify.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2003-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.
@@ -623,12 +623,12 @@ ren__map(Key, Ren) ->
%% ---------------------------------------------------------------------
%% State
-%% pmatch = 'true' | 'false' | 'no_duplicates' | 'duplicate_all'
+-type pmatch() :: 'true' | 'false' | 'no_duplicates' | 'duplicate_all'.
--record(state, {module::atom(),
- function::{atom(), 0..256},
- pmatch=true,
- revisit = false}).
+-record(state, {module :: module(),
+ function :: {atom(), arity()} | 'undefined',
+ pmatch = true :: pmatch(),
+ revisit = false :: boolean()}).
s__new(Module) ->
#state{module = Module}.
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 9f23b6a9b3..7684dc4a81 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -46,7 +46,6 @@
t_bitstr/0,
t_boolean/0,
t_byte/0,
- t_char/0,
t_cons/0,
t_cons/2,
t_cons_hd/1,
@@ -87,7 +86,6 @@
t_is_port/2,
t_is_maybe_improper_list/2,
t_is_reference/2,
- t_is_string/1,
t_is_subtype/2,
t_is_tuple/2,
t_list/0,
@@ -139,7 +137,7 @@ type(M, F, A) ->
type(M, F, A, Xs) ->
type(M, F, A, Xs, 'universe').
--type opaques() :: 'universe' | [erl_types:erl_type()].
+-type opaques() :: erl_types:opaques().
-type arg_types() :: [erl_types:erl_type()].
@@ -552,9 +550,6 @@ type(erlang, bit_size, 1, Xs, Opaques) ->
type(erlang, byte_size, 1, Xs, Opaques) ->
strict(erlang, byte_size, 1, Xs,
fun (_) -> t_non_neg_integer() end, Opaques);
-type(erlang, disconnect_node, 1, Xs, Opaques) ->
- strict(erlang, disconnect_node, 1, Xs,
- fun (_) -> t_sup([t_boolean(), t_atom('ignored')]) end, Opaques);
%% Guard bif, needs to be here.
%% Also much more expressive than anything you could write in a spec...
type(erlang, element, 2, Xs, Opaques) ->
@@ -583,16 +578,9 @@ type(erlang, element, 2, Xs, Opaques) ->
%% Guard bif, needs to be here.
type(erlang, float, 1, Xs, Opaques) ->
strict(erlang, float, 1, Xs, fun (_) -> t_float() end, Opaques);
-type(erlang, fun_info, 1, Xs, Opaques) ->
- strict(erlang, fun_info, 1, Xs,
- fun (_) -> t_list(t_tuple([t_atom(), t_any()])) end, Opaques);
-type(erlang, get_cookie, 0, _, _Opaques) -> t_atom(); % | t_atom('nocookie')
%% Guard bif, needs to be here.
type(erlang, hd, 1, Xs, Opaques) ->
strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end, Opaques);
-type(erlang, integer_to_list, 2, Xs, Opaques) ->
- strict(erlang, integer_to_list, 2, Xs,
- fun (_) -> t_string() end, Opaques);
type(erlang, info, 1, Xs, _) -> type(erlang, system_info, 1, Xs); % alias
%% All type tests are guard BIF's and may be implemented in ways that
%% cannot be expressed in a type spec, why they are kept in erl_bif_types.
@@ -796,8 +784,6 @@ type(erlang, make_tuple, 3, Xs, Opaques) ->
_Other -> t_tuple()
end
end, Opaques);
-type(erlang, memory, 0, _, _Opaques) ->
- t_list(t_tuple([t_atom(), t_non_neg_fixnum()]));
type(erlang, nif_error, 1, Xs, Opaques) ->
%% this BIF and the next one are stubs for NIFs and never return
strict(erlang, nif_error, 1, Xs, fun (_) -> t_any() end, Opaques);
@@ -813,8 +799,6 @@ type(erlang, round, 1, Xs, Opaques) ->
strict(erlang, round, 1, Xs, fun (_) -> t_integer() end, Opaques);
%% Guard bif, needs to be here.
type(erlang, self, 0, _, _Opaques) -> t_pid();
-type(erlang, set_cookie, 2, Xs, Opaques) ->
- strict(erlang, set_cookie, 2, Xs, fun (_) -> t_atom('true') end, Opaques);
type(erlang, setelement, 3, Xs, Opaques) ->
strict(erlang, setelement, 3, Xs,
fun ([X1, X2, X3]) ->
@@ -849,19 +833,7 @@ type(erlang, setelement, 3, Xs, Opaques) ->
%% Guard bif, needs to be here.
type(erlang, size, 1, Xs, Opaques) ->
strict(erlang, size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques);
-type(erlang, spawn, 1, Xs, Opaques) ->
- strict(erlang, spawn, 1, Xs, fun (_) -> t_pid() end, Opaques);
-type(erlang, spawn, 2, Xs, Opaques) ->
- strict(erlang, spawn, 2, Xs, fun (_) -> t_pid() end, Opaques);
-type(erlang, spawn, 4, Xs, Opaques) ->
- strict(erlang, spawn, 4, Xs, fun (_) -> t_pid() end, Opaques);
-type(erlang, spawn_link, 1, Xs, _) -> type(erlang, spawn, 1, Xs); % same
-type(erlang, spawn_link, 2, Xs, _) -> type(erlang, spawn, 2, Xs); % same
-type(erlang, spawn_link, 4, Xs, _) -> type(erlang, spawn, 4, Xs); % same
type(erlang, subtract, 2, Xs, _Opaques) -> type(erlang, '--', 2, Xs); % alias
-type(erlang, suspend_process, 1, Xs, Opaques) ->
- strict(erlang, suspend_process, 1, Xs,
- fun (_) -> t_atom('true') end, Opaques);
type(erlang, system_info, 1, Xs, Opaques) ->
strict(erlang, system_info, 1, Xs,
fun ([Type]) ->
@@ -926,8 +898,7 @@ type(erlang, system_info, 1, Xs, Opaques) ->
t_list(t_pid());
['os_type'] ->
t_tuple([t_sup([t_atom('unix'),
- t_atom('win32'),
- t_atom('ose')]),
+ t_atom('win32')]),
t_atom()]);
['os_version'] ->
t_sup(t_tuple([t_non_neg_fixnum(),
@@ -1015,10 +986,6 @@ type(erlang, tuple_to_list, 1, Xs, Opaques) ->
end
end
end, Opaques);
-type(erlang, yield, 0, _, _Opaques) -> t_atom('true');
-%%-- ets ----------------------------------------------------------------------
-type(ets, rename, 2, Xs, Opaques) ->
- strict(ets, rename, 2, Xs, fun ([_, Name]) -> Name end, Opaques);
%%-- hipe_bifs ----------------------------------------------------------------
type(hipe_bifs, add_ref, 2, Xs, Opaques) ->
strict(hipe_bifs, add_ref, 2, Xs, fun (_) -> t_nil() end, Opaques);
@@ -1678,25 +1645,6 @@ type(lists, zipwith3, 4, Xs, Opaques) ->
fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F, Opaques)),
t_nil()) end, Opaques);
-%%-- string -------------------------------------------------------------------
-type(string, chars, 2, Xs, Opaques) -> % NOTE: added to avoid loss of info
- strict(string, chars, 2, Xs, fun (_) -> t_string() end, Opaques);
-type(string, chars, 3, Xs, Opaques) -> % NOTE: added to avoid loss of info
- strict(string, chars, 3, Xs,
- fun ([Char, N, Tail]) ->
- case t_is_nil(Tail) of
- true ->
- type(string, chars, 2, [Char, N]);
- false ->
- case t_is_string(Tail) of
- true ->
- t_string();
- false ->
- t_sup(t_sup(t_string(), Tail), t_cons(Char, Tail))
- end
- end
- end, Opaques);
-
%%-----------------------------------------------------------------------------
type(M, F, A, Xs, _O) when is_atom(M), is_atom(F),
is_integer(A), 0 =< A, A =< 255 ->
@@ -2301,8 +2249,6 @@ arg_types(erlang, bit_size, 1) ->
%% Guard bif, needs to be here.
arg_types(erlang, byte_size, 1) ->
[t_bitstr()];
-arg_types(erlang, disconnect_node, 1) ->
- [t_node()];
arg_types(erlang, halt, 0) ->
[];
arg_types(erlang, halt, 1) ->
@@ -2322,17 +2268,11 @@ arg_types(erlang, element, 2) ->
%% Guard bif, needs to be here.
arg_types(erlang, float, 1) ->
[t_number()];
-arg_types(erlang, fun_info, 1) ->
- [t_fun()];
-arg_types(erlang, get_cookie, 0) ->
- [];
%% Guard bif, needs to be here.
arg_types(erlang, hd, 1) ->
[t_cons()];
arg_types(erlang, info, 1) ->
arg_types(erlang, system_info, 1); % alias
-arg_types(erlang, integer_to_list, 2) ->
- [t_integer(), t_from_range(2, 36)];
arg_types(erlang, is_atom, 1) ->
[t_any()];
arg_types(erlang, is_binary, 1) ->
@@ -2379,8 +2319,6 @@ arg_types(erlang, make_tuple, 2) ->
[t_non_neg_fixnum(), t_any()]; % the value 0 is OK as first argument
arg_types(erlang, make_tuple, 3) ->
[t_non_neg_fixnum(), t_any(), t_list(t_tuple([t_pos_integer(), t_any()]))];
-arg_types(erlang, memory, 0) ->
- [];
arg_types(erlang, nif_error, 1) ->
[t_any()];
arg_types(erlang, nif_error, 2) ->
@@ -2397,29 +2335,13 @@ arg_types(erlang, round, 1) ->
%% Guard bif, needs to be here.
arg_types(erlang, self, 0) ->
[];
-arg_types(erlang, set_cookie, 2) ->
- [t_node(), t_atom()];
arg_types(erlang, setelement, 3) ->
[t_pos_integer(), t_tuple(), t_any()];
%% Guard bif, needs to be here.
arg_types(erlang, size, 1) ->
[t_sup(t_tuple(), t_binary())];
-arg_types(erlang, spawn, 1) -> %% TODO: Tuple?
- [t_fun()];
-arg_types(erlang, spawn, 2) -> %% TODO: Tuple?
- [t_node(), t_fun()];
-arg_types(erlang, spawn, 4) -> %% TODO: Tuple?
- [t_node(), t_atom(), t_atom(), t_list()];
-arg_types(erlang, spawn_link, 1) ->
- arg_types(erlang, spawn, 1); % same
-arg_types(erlang, spawn_link, 2) ->
- arg_types(erlang, spawn, 2); % same
-arg_types(erlang, spawn_link, 4) ->
- arg_types(erlang, spawn, 4); % same
arg_types(erlang, subtract, 2) ->
arg_types(erlang, '--', 2);
-arg_types(erlang, suspend_process, 1) ->
- [t_pid()];
arg_types(erlang, system_info, 1) ->
[t_sup([t_atom(), % documented
t_tuple([t_atom(), t_any()]), % documented
@@ -2438,11 +2360,6 @@ arg_types(erlang, tuple_size, 1) ->
[t_tuple()];
arg_types(erlang, tuple_to_list, 1) ->
[t_tuple()];
-arg_types(erlang, yield, 0) ->
- [];
-%%------- ets -----------------------------------------------------------------
-arg_types(ets, rename, 2) ->
- [t_atom(), t_atom()];
%%------- hipe_bifs -----------------------------------------------------------
arg_types(hipe_bifs, add_ref, 2) ->
[t_mfa(), t_tuple([t_mfa(),
@@ -2639,13 +2556,6 @@ arg_types(lists, zipwith, 3) ->
[t_fun([t_any(), t_any()], t_any()), t_list(), t_list()];
arg_types(lists, zipwith3, 4) ->
[t_fun([t_any(), t_any(), t_any()], t_any()), t_list(), t_list(), t_list()];
-
-%%------- string --------------------------------------------------------------
-arg_types(string, chars, 2) ->
- [t_char(), t_non_neg_integer()];
-arg_types(string, chars, 3) ->
- [t_char(), t_non_neg_integer(), t_any()];
-%%-----------------------------------------------------------------------------
arg_types(M, F, A) when is_atom(M), is_atom(F),
is_integer(A), 0 =< A, A =< 255 ->
unknown. % safe approximation for all functions.
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 7a2abc226f..fae12d7421 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -140,7 +140,6 @@
t_is_port/1, t_is_port/2,
t_is_maybe_improper_list/1, t_is_maybe_improper_list/2,
t_is_reference/1, t_is_reference/2,
- t_is_remote/1,
t_is_string/1,
t_is_subtype/2,
t_is_tuple/1, t_is_tuple/2,
@@ -173,14 +172,12 @@
t_number_vals/1, t_number_vals/2,
t_opaque_from_records/1,
t_opaque_structure/1,
- %% t_parameterized_module/0,
t_pid/0,
t_port/0,
t_maybe_improper_list/0,
%% t_maybe_improper_list/2,
t_product/1,
t_reference/0,
- t_remote/3,
t_string/0,
t_struct_from_opaque/2,
t_subst/2,
@@ -208,7 +205,6 @@
type_is_defined/4,
record_field_diffs_to_string/2,
subst_all_vars_to_any/1,
- subst_all_remote/2,
lift_list_to_pos_empty/1, lift_list_to_pos_empty/2,
is_opaque_type/2,
is_erl_type/1,
@@ -228,7 +224,7 @@
-export([t_is_identifier/1]).
-endif.
--export_type([erl_type/0, type_table/0, var_table/0]).
+-export_type([erl_type/0, opaques/0, type_table/0, var_table/0]).
%%-define(DEBUG, true).
@@ -280,7 +276,6 @@
-define(number_tag, number).
-define(opaque_tag, opaque).
-define(product_tag, product).
--define(remote_tag, remote).
-define(tuple_set_tag, tuple_set).
-define(tuple_tag, tuple).
-define(union_tag, union).
@@ -288,7 +283,7 @@
-type tag() :: ?atom_tag | ?binary_tag | ?function_tag | ?identifier_tag
| ?list_tag | ?map_tag | ?matchstate_tag | ?nil_tag | ?number_tag
- | ?opaque_tag | ?product_tag | ?remote_tag
+ | ?opaque_tag | ?product_tag
| ?tuple_tag | ?tuple_set_tag | ?union_tag | ?var_tag.
-define(float_qual, float).
@@ -320,7 +315,7 @@
%% Auxiliary types and convenient macros
%%
--type parse_form() :: {atom(), _, _} | {atom(), _, _, _} | {'op', _, _, _, _}. %% XXX: Temporarily
+-type parse_form() :: erl_parse:abstract_expr().
-type rng_elem() :: 'pos_inf' | 'neg_inf' | integer().
-record(int_set, {set :: [integer()]}).
@@ -330,7 +325,6 @@
%% was updated to 2.7 due to this change.
-record(opaque, {mod :: module(), name :: atom(),
args = [] :: [erl_type()], struct :: erl_type()}).
--record(remote, {mod:: module(), name :: atom(), args = [] :: [erl_type()]}).
-define(atom(Set), #c{tag=?atom_tag, elements=Set}).
-define(bitstr(Unit, Base), #c{tag=?binary_tag, elements=[Unit,Base]}).
@@ -350,7 +344,6 @@
-define(map(Pairs), #c{tag=?map_tag, elements=Pairs}).
-define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}).
-define(product(Types), #c{tag=?product_tag, elements=Types}).
--define(remote(RemTypes), #c{tag=?remote_tag, elements=RemTypes}).
-define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types,
qualifier={Arity, Qual}}).
-define(tuple_set(Tuples), #c{tag=?tuple_set_tag, elements=Tuples}).
@@ -371,8 +364,8 @@
-type type_key() :: {'type' | 'opaque', atom(), arity()}.
-type record_value() :: [{atom(), erl_parse:abstract_expr(), erl_type()}].
-type type_value() :: {module(), erl_type(), atom()}.
--type type_table() :: dict:dict(record_key(), record_value())
- | dict:dict(type_key(), type_value()).
+-type type_table() :: dict:dict(record_key() | type_key(),
+ record_value() | type_value()).
-type var_table() :: dict:dict(atom(), erl_type()).
@@ -380,19 +373,18 @@
%% Unions
%%
--define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_,_]=List}).
-
--define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none,?none])).
--define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none,?none])).
--define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none,?none])).
--define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none,?none])).
--define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none,?none])).
--define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none,?none])).
--define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none,?none])).
--define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none,?none])).
--define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none,?none])).
--define(remote_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T,?none])).
--define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,?none,T])).
+-define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_]=List}).
+
+-define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none])).
+-define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none])).
+-define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none])).
+-define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none])).
+-define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none])).
+-define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none])).
+-define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none])).
+-define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none])).
+-define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none])).
+-define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T])).
-define(integer_union(T), ?number_union(T)).
-define(float_union(T), ?number_union(T)).
-define(nil_union(T), ?list_union(T)).
@@ -679,8 +671,8 @@ list_decorate(List, L, Opaques) ->
union_decorate(U1, U2, Opaques) ->
Union = union_decorate(U1, U2, Opaques, 0, []),
- [A,B,F,I,L,N,T,M,_,_R,Map] = U1,
- [_,_,_,_,_,_,_,_,Opaque,_,_] = U2,
+ [A,B,F,I,L,N,T,M,_,Map] = U1,
+ [_,_,_,_,_,_,_,_,Opaque,_] = U2,
List = [A,B,F,I,L,N,T,M,Map],
DecList = [Dec ||
E <- List,
@@ -792,21 +784,6 @@ list_struct_from_opaque(Types, Opaques) ->
[t_struct_from_opaque(Type, Opaques) || Type <- Types].
%%-----------------------------------------------------------------------------
-%% Remote types: these types are used for preprocessing;
-%% they should never reach the analysis stage.
-
--spec t_remote(atom(), atom(), [erl_type()]) -> erl_type().
-
-t_remote(Mod, Name, Args) ->
- ?remote(set_singleton(#remote{mod = Mod, name = Name, args = Args})).
-
--spec t_is_remote(erl_type()) -> boolean().
-
-t_is_remote(Type) ->
- do_opaque(Type, 'universe', fun is_remote/1).
-
-is_remote(?remote(_)) -> true;
-is_remote(_) -> false.
-type mod_records() :: dict:dict(module(), type_table()).
@@ -1807,7 +1784,7 @@ t_mfa() ->
-spec t_module() -> erl_type().
t_module() ->
- t_sup(t_atom(), t_parameterized_module()).
+ t_atom().
-spec t_node() -> erl_type().
@@ -1833,11 +1810,6 @@ t_iolist(N, T) when N > 0 ->
t_iolist(0, T) ->
t_maybe_improper_list(t_any(), t_sup(T, t_nil())).
--spec t_parameterized_module() -> erl_type().
-
-t_parameterized_module() ->
- t_tuple().
-
-spec t_timeout() -> erl_type().
t_timeout() ->
@@ -2178,8 +2150,6 @@ t_sup(?opaque(Set1), ?opaque(Set2)) ->
%% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none;
%%t_sup(T1, T2=?opaque(_,_,_)) ->
%% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none;
-t_sup(?remote(Set1), ?remote(Set2)) ->
- ?remote(set_union_no_limit(Set1, Set2));
t_sup(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2)) ->
?matchstate(t_sup(Pres1, Pres2), t_sup(Slots1, Slots2));
t_sup(?nil, ?nil) -> ?nil;
@@ -2373,7 +2343,6 @@ force_union(T = ?list(_, _, _)) -> ?list_union(T);
force_union(T = ?nil) -> ?list_union(T);
force_union(T = ?number(_, _)) -> ?number_union(T);
force_union(T = ?opaque(_)) -> ?opaque_union(T);
-force_union(T = ?remote(_)) -> ?remote_union(T);
force_union(T = ?map(_)) -> ?map_union(T);
force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T);
force_union(T = ?tuple_set(_)) -> ?tuple_union(T);
@@ -2450,8 +2419,7 @@ t_inf(T1, T2) ->
t_inf(T1, T2, 'universe').
%% 'match' should be used from t_find_unknown_opaque() only
--type t_inf_opaques() :: 'universe'
- | [erl_type()] | {'match', [erl_type() | 'universe']}.
+-type t_inf_opaques() :: opaques() | {'match', [erl_type() | 'universe']}.
-spec t_inf(erl_type(), erl_type(), t_inf_opaques()) -> erl_type().
@@ -2886,8 +2854,8 @@ inf_tuples_in_sets2(_, [], Acc, _Opaques) -> lists:reverse(Acc).
inf_union(U1, U2, Opaques) ->
OpaqueFun =
fun(Union1, Union2, InfFun) ->
- [_,_,_,_,_,_,_,_,Opaque,_,_] = Union1,
- [A,B,F,I,L,N,T,M,_,_R,Map] = Union2,
+ [_,_,_,_,_,_,_,_,Opaque,_] = Union1,
+ [A,B,F,I,L,N,T,M,_,Map] = Union2,
List = [A,B,F,I,L,N,T,M,Map],
inf_union_collect(List, Opaque, InfFun, [], [])
end,
@@ -3066,18 +3034,6 @@ t_subst_aux(?union(List), VarMap) ->
?union([t_subst_aux(E, VarMap) || E <- List]);
t_subst_aux(T, _VarMap) ->
T.
-
--spec subst_all_remote(erl_type(), erl_type()) -> erl_type().
-
-subst_all_remote(Type0, Substitute) ->
- Map =
- fun(Type) ->
- case t_is_remote(Type) of
- true -> Substitute;
- false -> Type
- end
- end,
- t_map(Map, Type0).
%%-----------------------------------------------------------------------------
%% Unification
@@ -3181,11 +3137,11 @@ unify_union1(?union(List), T1, T2) ->
end.
unify_union(List) ->
- [A,B,F,I,L,N,T,M,O,R,Map] = List,
+ [A,B,F,I,L,N,T,M,O,Map] = List,
if O =:= ?none -> no;
true ->
S = t_opaque_structure(O),
- {yes, t_sup([A,B,F,I,L,N,T,M,S,R,Map])}
+ {yes, t_sup([A,B,F,I,L,N,T,M,S,Map])}
end.
-spec is_opaque_type(erl_type(), [erl_type()]) -> boolean().
@@ -3543,10 +3499,10 @@ t_subtract_lists([], [], Acc) ->
-spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type().
subtract_union(U1, U2) ->
- [A1,B1,F1,I1,L1,N1,T1,M1,O1,R1,Map1] = U1,
- [A2,B2,F2,I2,L2,N2,T2,M2,O2,R2,Map2] = U2,
- List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,R1,Map1],
- List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,R2,Map2],
+ [A1,B1,F1,I1,L1,N1,T1,M1,O1,Map1] = U1,
+ [A2,B2,F2,I2,L2,N2,T2,M2,O2,Map2] = U2,
+ List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,Map1],
+ List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,Map2],
Sub1 = subtract_union(List1, List2, 0, []),
O = if O1 =:= ?none -> O1;
true -> t_subtract(O1, ?union(U2))
@@ -3641,7 +3597,7 @@ t_is_instance(ConcreteType, Type) ->
t_unopaque(T) ->
t_unopaque(T, 'universe').
--spec t_unopaque(erl_type(), 'universe' | [erl_type()]) -> erl_type().
+-spec t_unopaque(erl_type(), opaques()) -> erl_type().
t_unopaque(?opaque(_) = T, Opaques) ->
case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of
@@ -3662,7 +3618,7 @@ t_unopaque(?product(Types), Opaques) ->
?product([t_unopaque(T, Opaques) || T <- Types]);
t_unopaque(?function(Domain, Range), Opaques) ->
?function(t_unopaque(Domain, Opaques), t_unopaque(Range, Opaques));
-t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) ->
+t_unopaque(?union([A,B,F,I,L,N,T,M,O,Map]), Opaques) ->
UL = t_unopaque(L, Opaques),
UT = t_unopaque(T, Opaques),
UF = t_unopaque(F, Opaques),
@@ -3671,7 +3627,7 @@ t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) ->
?opaque(_) = O1 -> {O1, []};
Type -> {?none, [Type]}
end,
- t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,UMap])|UO]);
+ t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,UMap])|UO]);
t_unopaque(T, _) ->
T.
@@ -3938,16 +3894,6 @@ t_to_string(?float, _RecDict) -> "float()";
t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()";
t_to_string(?product(List), RecDict) ->
"<" ++ comma_sequence(List, RecDict) ++ ">";
-t_to_string(?remote(Set), RecDict) ->
- string:join([case Args =:= [] of
- true -> flat_format("~w:~w()", [Mod, Name]);
- false ->
- ArgString = comma_sequence(Args, RecDict),
- flat_format("~w:~w(~s)", [Mod, Name, ArgString])
- end
- || #remote{mod = Mod, name = Name, args = Args} <-
- set_to_list(Set)],
- " | ");
t_to_string(?map(Pairs), RecDict) ->
"#{" ++ map_pairs_to_string(Pairs,RecDict) ++ "}";
t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()";
@@ -3980,18 +3926,17 @@ record_to_string(Tag, [_|Fields], FieldNames, RecDict) ->
FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []),
"#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}".
-record_fields_to_string([F|Fs], [{FName, _Abstr, _DefType}|FDefs],
+record_fields_to_string([F|Fs], [{FName, _Abstr, DefType}|FDefs],
RecDict, Acc) ->
NewAcc =
- case t_is_equal(F, t_any()) orelse t_is_any_atom('undefined', F) of
+ case
+ t_is_equal(F, t_any()) orelse
+ (t_is_any_atom('undefined', F) andalso
+ not t_is_none(t_inf(F, DefType)))
+ of
true -> Acc;
false ->
StrFV = atom_to_string(FName) ++ "::" ++ t_to_string(F, RecDict),
- %% ActualDefType = t_subtract(DefType, t_atom('undefined')),
- %% Str = case t_is_any(ActualDefType) of
- %% true -> StrFV;
- %% false -> StrFV ++ "::" ++ t_to_string(ActualDefType, RecDict)
- %% end,
[StrFV|Acc]
end,
record_fields_to_string(Fs, FDefs, RecDict, NewAcc);
@@ -4831,13 +4776,13 @@ do_opaque(?opaque(_) = Type, Opaques, Pred) ->
false -> Pred(Type)
end;
do_opaque(?union(List) = Type, Opaques, Pred) ->
- [A,B,F,I,L,N,T,M,O,R,Map] = List,
+ [A,B,F,I,L,N,T,M,O,Map] = List,
if O =:= ?none -> Pred(Type);
true ->
case Opaques =:= 'universe' orelse is_opaque_type(O, Opaques) of
true ->
S = t_opaque_structure(O),
- do_opaque(t_sup([A,B,F,I,L,N,T,M,S,R,Map]), Opaques, Pred);
+ do_opaque(t_sup([A,B,F,I,L,N,T,M,S,Map]), Opaques, Pred);
false -> Pred(Type)
end
end;
@@ -4871,10 +4816,6 @@ set_union(S1, S2) ->
_ -> ?any
end.
-set_union_no_limit(?any, _) -> ?any;
-set_union_no_limit(_, ?any) -> ?any;
-set_union_no_limit(S1, S2) -> ordsets:union(S1, S2).
-
%% The intersection and subtraction can return ?none.
%% This should always be handled right away since ?none is not a valid set.
%% However, ?any is considered a valid set.
diff --git a/lib/hipe/flow/cfg.hrl b/lib/hipe/flow/cfg.hrl
index f79fff4efe..641ec102db 100644
--- a/lib/hipe/flow/cfg.hrl
+++ b/lib/hipe/flow/cfg.hrl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
@@ -34,11 +34,13 @@
%%
-record(cfg_info, {'fun' :: mfa(),
start_label :: cfg_lbl(),
+ %% TODO: merge is_closure and closure_arity into one field
is_closure :: boolean(),
- closure_arity :: arity(),
+ closure_arity = none :: 'none' | arity(),
is_leaf :: boolean(),
params, % :: list()
info = []}). %% this field seems not needed; take out??
+-type cfg_info() :: #cfg_info{}.
%%
%% Data is a triple with a dict of constants, a list of labels and an integer
@@ -49,6 +51,6 @@
%% The following is to be used by other modules
%%
-record(cfg, {table = gb_trees:empty() :: gb_trees:tree(),
- info :: #cfg_info{},
+ info :: cfg_info(),
data :: cfg_data()}).
-type cfg() :: #cfg{}.
diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl
index 5c7003b0ed..07d230491d 100644
--- a/lib/hipe/icode/hipe_icode.erl
+++ b/lib/hipe/icode/hipe_icode.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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.
@@ -631,59 +631,59 @@ mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) ->
-spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()],
hipe_consttab(), {non_neg_integer(),non_neg_integer()},
- {icode_lbl(),icode_lbl()}) -> #icode{}.
+ {icode_lbl(),icode_lbl()}) -> icode().
mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) ->
#icode{'fun'=Fun, params=Params, code=Code,
data=Data, is_closure=IsClosure, is_leaf=IsLeaf,
var_range=VarRange, label_range=LabelRange}.
--spec icode_fun(#icode{}) -> mfa().
+-spec icode_fun(icode()) -> mfa().
icode_fun(#icode{'fun' = MFA}) -> MFA.
--spec icode_params(#icode{}) -> [icode_var()].
+-spec icode_params(icode()) -> [icode_var()].
icode_params(#icode{params = Params}) -> Params.
--spec icode_params_update(#icode{}, [icode_var()]) -> #icode{}.
+-spec icode_params_update(icode(), [icode_var()]) -> icode().
icode_params_update(Icode, Params) ->
Icode#icode{params = Params}.
--spec icode_is_closure(#icode{}) -> boolean().
+-spec icode_is_closure(icode()) -> boolean().
icode_is_closure(#icode{is_closure = Closure}) -> Closure.
--spec icode_is_leaf(#icode{}) -> boolean().
+-spec icode_is_leaf(icode()) -> boolean().
icode_is_leaf(#icode{is_leaf = Leaf}) -> Leaf.
--spec icode_code(#icode{}) -> icode_instrs().
+-spec icode_code(icode()) -> icode_instrs().
icode_code(#icode{code = Code}) -> Code.
--spec icode_code_update(#icode{}, icode_instrs()) -> #icode{}.
+-spec icode_code_update(icode(), icode_instrs()) -> icode().
icode_code_update(Icode, NewCode) ->
Vmax = highest_var(NewCode),
Lmax = highest_label(NewCode),
Icode#icode{code = NewCode, var_range = {0,Vmax}, label_range = {0,Lmax}}.
--spec icode_data(#icode{}) -> hipe_consttab().
+-spec icode_data(icode()) -> hipe_consttab().
icode_data(#icode{data=Data}) -> Data.
-%% %% -spec icode_data_update(#icode{}, hipe_consttab()) -> #icode{}.
+%% %% -spec icode_data_update(icode(), hipe_consttab()) -> icode().
%% icode_data_update(Icode, NewData) -> Icode#icode{data=NewData}.
--spec icode_var_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}.
+-spec icode_var_range(icode()) -> {non_neg_integer(), non_neg_integer()}.
icode_var_range(#icode{var_range = VarRange}) -> VarRange.
--spec icode_label_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}.
+-spec icode_label_range(icode()) -> {non_neg_integer(), non_neg_integer()}.
icode_label_range(#icode{label_range = LabelRange}) -> LabelRange.
--spec icode_info(#icode{}) -> icode_info().
+-spec icode_info(icode()) -> icode_info().
icode_info(#icode{info = Info}) -> Info.
--spec icode_info_update(#icode{}, icode_info()) -> #icode{}.
+-spec icode_info_update(icode(), icode_info()) -> icode().
icode_info_update(Icode, Info) -> Icode#icode{info = Info}.
--spec icode_closure_arity(#icode{}) -> arity().
+-spec icode_closure_arity(icode()) -> arity().
icode_closure_arity(#icode{closure_arity = Arity}) -> Arity.
--spec icode_closure_arity_update(#icode{}, arity()) -> #icode{}.
+-spec icode_closure_arity_update(icode(), arity()) -> icode().
icode_closure_arity_update(Icode, Arity) -> Icode#icode{closure_arity = Arity}.
@@ -1376,12 +1376,12 @@ remove_constants(L) ->
%% Substitution: replace occurrences of X by Y if {X,Y} is in the
%% Subst_list.
--spec subst([{_,_}], I) -> I when is_subtype(I, icode_instr()).
+-spec subst([{_,_}], I) -> I when I :: icode_instr().
subst(Subst, I) ->
subst_defines(Subst, subst_uses(Subst, I)).
--spec subst_uses([{_,_}], I) -> I when is_subtype(I, icode_instr()).
+-spec subst_uses([{_,_}], I) -> I when I :: icode_instr().
subst_uses(Subst, I) ->
case I of
@@ -1405,7 +1405,7 @@ subst_uses(Subst, I) ->
#icode_label{} -> I
end.
--spec subst_defines([{_,_}], I) -> I when is_subtype(I, icode_instr()).
+-spec subst_defines([{_,_}], I) -> I when I :: icode_instr().
subst_defines(Subst, I) ->
case I of
@@ -1709,7 +1709,7 @@ mk_new_label() ->
%% @doc Removes comments from Icode.
%%
--spec strip_comments(#icode{}) -> #icode{}.
+-spec strip_comments(icode()) -> icode().
strip_comments(ICode) ->
icode_code_update(ICode, no_comments(icode_code(ICode))).
diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl
index 9b24c4914e..3bb7bae019 100644
--- a/lib/hipe/icode/hipe_icode.hrl
+++ b/lib/hipe/icode/hipe_icode.hrl
@@ -170,8 +170,9 @@
-record(icode, {'fun' :: mfa(),
params :: [icode_var()],
+ %% TODO: merge is_closure and closure_arity into one field
is_closure :: boolean(),
- closure_arity :: arity(),
+ closure_arity = none :: 'none' | arity(),
is_leaf :: boolean(),
code = [] :: icode_instrs(),
data :: hipe_consttab(),
diff --git a/lib/hipe/icode/hipe_icode_exceptions.erl b/lib/hipe/icode/hipe_icode_exceptions.erl
index 41556ab80f..f03ce2faaa 100644
--- a/lib/hipe/icode/hipe_icode_exceptions.erl
+++ b/lib/hipe/icode/hipe_icode_exceptions.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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.
@@ -85,7 +85,7 @@
%%----------------------------------------------------------------------------
--spec fix_catches(#cfg{}) -> #cfg{}.
+-spec fix_catches(cfg()) -> cfg().
fix_catches(CFG) ->
{Map, State} = build_mapping(find_catches(init_state(CFG))),
@@ -393,10 +393,10 @@ get_renaming(C, Map) ->
%%---------------------------------------------------------------------
%% State abstraction
--record(state, {cfg :: #cfg{},
+-record(state, {cfg :: cfg(),
changed = false :: boolean(),
- succ :: #cfg{},
- pred :: #cfg{},
+ succ :: cfg(),
+ pred :: cfg(),
start_labels :: [icode_lbl(),...],
visited = hipe_icode_cfg:none_visited() :: gb_sets:set(),
out = gb_trees:empty() :: gb_trees:tree(),
@@ -404,13 +404,8 @@ get_renaming(C, Map) ->
}).
init_state(CFG) ->
- State = #state{cfg = CFG},
- refresh_state_cache(State).
-
-refresh_state_cache(State) ->
- CFG = State#state.cfg,
SLs = [hipe_icode_cfg:start_label(CFG)],
- State#state{succ = CFG, pred = CFG, start_labels = SLs}.
+ #state{cfg = CFG, succ = CFG, pred = CFG, start_labels = SLs}.
get_cfg(State) ->
State#state.cfg.
@@ -466,7 +461,8 @@ get_bb_code(L, State) ->
set_bb_code(L, Code, State) ->
CFG = State#state.cfg,
CFG1 = hipe_icode_cfg:bb_add(CFG, L, hipe_bb:mk_bb(Code)),
- refresh_state_cache(State#state{cfg = CFG1}).
+ SLs = [hipe_icode_cfg:start_label(CFG1)],
+ State#state{cfg = CFG1, succ = CFG1, pred = CFG1, start_labels = SLs}.
get_new_catches_in(L, State) ->
Ps = get_pred(L, State),
diff --git a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl
index e350a6ff18..7613024787 100644
--- a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl
+++ b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
@@ -314,7 +314,7 @@ node_create(Label, Pred, Succ) ->
%% tree - the tree of nodes, with labels as keys and node records as values
-record(nodes, {
- domtree :: hipe_dominators:domTree(),
+ domtree = none :: 'none' | hipe_dominators:domTree(),
labels = none :: 'none' | [icode_lbl()],
postorder = none :: 'none' | [icode_lbl()],
start_label = none :: 'none' | icode_lbl(),
@@ -390,7 +390,7 @@ update_del_red_test_set(Update) ->
%%-----------------------------------------------------------------------------
%% Main function called from the hipe_main module
--spec struct_reuse(#cfg{}) -> #cfg{}.
+-spec struct_reuse(cfg()) -> cfg().
struct_reuse(CFG) ->
%% debug_init_case_count(?SR_INSTR_TYPE),
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
index 1a4bbf179f..0e32da1d36 100644
--- a/lib/hipe/main/hipe.erl
+++ b/lib/hipe/main/hipe.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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.
@@ -764,7 +764,8 @@ finalize(OrigList, Mod, Exports, WholeModule, Opts) ->
finalize_fun(MfaIcodeList, Exports, Opts) ->
case proplists:get_value(concurrent_comp, Opts) of
FalseVal when (FalseVal =:= undefined) orelse (FalseVal =:= false) ->
- [finalize_fun_sequential(MFAIcode, Opts, #comp_servers{})
+ NoServers = #comp_servers{pp_server = none, range = none, type = none},
+ [finalize_fun_sequential(MFAIcode, Opts, NoServers)
|| {_MFA, _Icode} = MFAIcode <- MfaIcodeList];
TrueVal when (TrueVal =:= true) orelse (TrueVal =:= debug) ->
finalize_fun_concurrent(MfaIcodeList, Exports, Opts)
diff --git a/lib/hipe/main/hipe.hrl.src b/lib/hipe/main/hipe.hrl.src
index ba27878a84..3be824ac34 100644
--- a/lib/hipe/main/hipe.hrl.src
+++ b/lib/hipe/main/hipe.hrl.src
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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.
@@ -299,7 +299,8 @@
%% Records defined in the hipe module used in other parts of the compiler
%%----------------------------------------------------------------------------
--record(comp_servers, {pp_server :: pid(), range :: pid(), type :: pid()}).
+-type mpid() :: 'none' | pid().
+-record(comp_servers, {pp_server :: mpid(), range :: mpid(), type :: mpid()}).
%%----------------------------------------------------------------------------
%% Basic types of the 'hipe' application used in other parts of the system
diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl
index 5753169961..be5050e155 100644
--- a/lib/hipe/main/hipe_main.erl
+++ b/lib/hipe/main/hipe_main.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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.
@@ -55,7 +55,7 @@
%%=====================================================================
%% @spec compile_icode(MFA::mfa(),
-%% LinearIcode::#icode{},
+%% LinearIcode::icode(),
%% CompilerOptions::comp_options(),
%% CompServers::#comp_servers()) ->
%% {native,Platform,{unprofiled,NativeCode}} | {rtl,RTLCode}
@@ -69,7 +69,7 @@
%% generated). The compiler options must have already been expanded
%% (cf. `<a href="hipe.html">hipe:expand_options</a>'). </p>
--spec compile_icode(mfa(), #icode{}, comp_options(), #comp_servers{}) ->
+-spec compile_icode(mfa(), icode(), comp_options(), #comp_servers{}) ->
comp_icode_ret().
compile_icode(MFA, LinearIcode, Options, Servers) ->
@@ -230,10 +230,12 @@ get_pp_module(icode_liveness) -> hipe_icode_liveness;
get_pp_module(rtl_liveness) -> hipe_rtl_liveness.
perform_io(no_fun, _) -> ok;
-perform_io(Fun,PPServer) when is_pid(PPServer) ->
- PPServer ! {print,Fun};
-perform_io(Fun, undefined) ->
- Fun().
+perform_io(Fun, PPServer) when is_pid(PPServer) ->
+ PPServer ! {print, Fun},
+ ok;
+perform_io(Fun, none) ->
+ Fun(),
+ ok.
%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile
index d781e4f9be..09f4fd2129 100644
--- a/lib/hipe/test/Makefile
+++ b/lib/hipe/test/Makefile
@@ -36,7 +36,7 @@ RELSYSDIR = $(RELEASE_PATH)/hipe_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl
index 24526f574d..368ad0cd20 100644
--- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl
+++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl
@@ -9,7 +9,7 @@
-export([test/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
test() ->
ok = utf8_cm65(),
diff --git a/lib/ic/test/Makefile b/lib/ic/test/Makefile
index 576ffc4eff..93cbaf4dfe 100644
--- a/lib/ic/test/Makefile
+++ b/lib/ic/test/Makefile
@@ -209,10 +209,8 @@ ERL_LOCAL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin
ERL_COMPILE_FLAGS += \
$(ERL_LOCAL_FLAGS) \
- -pa $(ERL_TOP)/lib/test_server/ebin \
-pa $(ERL_TOP)/lib/orber/ebin \
- -I$(ERL_TOP)/lib/orber \
- -I$(ERL_TOP)/lib/test_server/include
+ -I$(ERL_TOP)/lib/orber
# ----------------------------------------------------
# Targets
diff --git a/lib/ic/test/ic_SUITE.erl b/lib/ic/test/ic_SUITE.erl
index bca75b8349..c9fbf49a55 100644
--- a/lib/ic/test/ic_SUITE.erl
+++ b/lib/ic/test/ic_SUITE.erl
@@ -23,7 +23,7 @@
%%%----------------------------------------------------------------------
-module(ic_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]).
diff --git a/lib/ic/test/ic_be_SUITE.erl b/lib/ic/test/ic_be_SUITE.erl
index 42c30fc86e..49dd9953cb 100644
--- a/lib/ic/test/ic_be_SUITE.erl
+++ b/lib/ic/test/ic_be_SUITE.erl
@@ -23,7 +23,7 @@
%%%----------------------------------------------------------------------
-module(ic_be_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,
diff --git a/lib/ic/test/ic_pp_SUITE.erl b/lib/ic/test/ic_pp_SUITE.erl
index ab22d532a1..e85ce788e3 100644
--- a/lib/ic/test/ic_pp_SUITE.erl
+++ b/lib/ic/test/ic_pp_SUITE.erl
@@ -23,7 +23,7 @@
%%----------------------------------------------------------------------
-module(ic_pp_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
diff --git a/lib/ic/test/ic_pragma_SUITE.erl b/lib/ic/test/ic_pragma_SUITE.erl
index e0ab43e178..c6e23a1f8c 100644
--- a/lib/ic/test/ic_pragma_SUITE.erl
+++ b/lib/ic/test/ic_pragma_SUITE.erl
@@ -28,7 +28,7 @@
%%-----------------------------------------------------------------
-module(ic_pragma_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
%%-----------------------------------------------------------------
%% External exports
diff --git a/lib/ic/test/ic_register_SUITE.erl b/lib/ic/test/ic_register_SUITE.erl
index e402692940..86d89e72d5 100644
--- a/lib/ic/test/ic_register_SUITE.erl
+++ b/lib/ic/test/ic_register_SUITE.erl
@@ -27,7 +27,7 @@
%%-----------------------------------------------------------------
-module(ic_register_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
%%-----------------------------------------------------------------
%% External exports
diff --git a/lib/ic/test/java_client_erl_server_SUITE.erl b/lib/ic/test/java_client_erl_server_SUITE.erl
index e95b3d5026..a670c5546e 100644
--- a/lib/ic/test/java_client_erl_server_SUITE.erl
+++ b/lib/ic/test/java_client_erl_server_SUITE.erl
@@ -23,7 +23,7 @@
%%%----------------------------------------------------------------------
-module(java_client_erl_server_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_group/2,end_per_group/2,
diff --git a/lib/inets/src/tftp/tftp_engine.erl b/lib/inets/src/tftp/tftp_engine.erl
index 8d282a1e9d..79203fd1a4 100644
--- a/lib/inets/src/tftp/tftp_engine.erl
+++ b/lib/inets/src/tftp/tftp_engine.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2005-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.
@@ -63,7 +63,8 @@
-record(file_info, {peer_req, pid}).
-record(sys_misc, {module, function, arguments}).
-record(error, {where, code, text, filename}).
--record(prepared, {status :: prep_status(), result, block_no, next_data, prev_data}).
+-record(prepared, {status :: prep_status() | 'undefined',
+ result, block_no, next_data, prev_data}).
-record(transfer_res, {status, decoded_msg, prepared}).
-define(ERROR(Where, Code, Text, Filename),
#error{where = Where, code = Code, text = Text, filename = Filename}).
diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile
index 607ec7c182..67c979bd59 100644
--- a/lib/inets/test/Makefile
+++ b/lib/inets/test/Makefile
@@ -42,7 +42,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
# Target Specs
# ----------------------------------------------------
INCLUDES = -I. \
- -I$(ERL_TOP)/lib/test_server/include/ \
-I$(ERL_TOP)/lib/inets/src/inets_app \
-I$(ERL_TOP)/lib/inets/src/http_lib \
-I$(ERL_TOP)/lib/inets/src/http_client \
@@ -238,7 +237,6 @@ RELTESTSYSBINDIR = $(RELTESTSYSALLDATADIR)/bin
# running the target "targets".
# ----------------------------------------------------
ERL_COMPILE_FLAGS += \
- -pa ../../../internal_tools/test_server/ebin \
$(INCLUDES) \
$(FTP_FLAGS) \
$(INETS_FLAGS)
diff --git a/lib/inets/test/ftp_format_SUITE.erl b/lib/inets/test/ftp_format_SUITE.erl
index 7ed94b9c61..9b71d2944b 100644
--- a/lib/inets/test/ftp_format_SUITE.erl
+++ b/lib/inets/test/ftp_format_SUITE.erl
@@ -22,7 +22,6 @@
-author('[email protected]').
-include_lib("common_test/include/ct.hrl").
--include("test_server_line.hrl").
-include("ftp_internal.hrl").
%% Test server specific exports
diff --git a/lib/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl
index 6d30f3aa62..2f9170fa0c 100644
--- a/lib/inets/test/ftp_suite_lib.erl
+++ b/lib/inets/test/ftp_suite_lib.erl
@@ -22,8 +22,8 @@
-module(ftp_suite_lib).
--include_lib("test_server/include/test_server.hrl").
--include_lib("test_server/include/test_server_line.hrl").
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("inets_test_lib.hrl").
%% Test server specific exports
diff --git a/lib/inets/test/httpc_cookie_SUITE.erl b/lib/inets/test/httpc_cookie_SUITE.erl
index 9a62bdb43f..2efca9a5c8 100644
--- a/lib/inets/test/httpc_cookie_SUITE.erl
+++ b/lib/inets/test/httpc_cookie_SUITE.erl
@@ -20,7 +20,7 @@
%%
-module(httpc_cookie_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("stdlib/include/ms_transform.hrl").
%% Test server specific exports
diff --git a/lib/inets/test/httpd_load.erl b/lib/inets/test/httpd_load.erl
index 39c2280f23..fef693d818 100644
--- a/lib/inets/test/httpd_load.erl
+++ b/lib/inets/test/httpd_load.erl
@@ -21,8 +21,7 @@
-module(httpd_load).
--include("test_server.hrl").
--include("test_server_line.hrl").
+-include_lib("common_test/include/ct.hrl").
%% General testcases bodies called from httpd_SUITE
-export([load_test/5]).
diff --git a/lib/inets/test/httpd_mod.erl b/lib/inets/test/httpd_mod.erl
index 847586a903..016989a22e 100644
--- a/lib/inets/test/httpd_mod.erl
+++ b/lib/inets/test/httpd_mod.erl
@@ -21,8 +21,7 @@
-module(httpd_mod).
--include("test_server.hrl").
--include("test_server_line.hrl").
+-include_lib("common_test/include/ct.hrl").
%% General testcases bodies called from httpd_SUITE
-export([alias/4, actions/4, security/5, auth/4, auth_api/6,
diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl
index aaaf69fbec..f972f0f435 100644
--- a/lib/inets/test/old_httpd_SUITE.erl
+++ b/lib/inets/test/old_httpd_SUITE.erl
@@ -21,8 +21,7 @@
-module(old_httpd_SUITE).
--include_lib("test_server/include/test_server.hrl").
--include("test_server_line.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("inets_test_lib.hrl").
-include_lib("kernel/include/file.hrl").
diff --git a/lib/jinterface/test/jinterface_SUITE.erl b/lib/jinterface/test/jinterface_SUITE.erl
index 6d34a21209..5c4618dcde 100644
--- a/lib/jinterface/test/jinterface_SUITE.erl
+++ b/lib/jinterface/test/jinterface_SUITE.erl
@@ -46,7 +46,6 @@
]).
-include_lib("common_test/include/ct.hrl").
--include("test_server_line.hrl").
-define(debug,true).
-ifdef(debug).
diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl
index c5f3198c21..9910334749 100644
--- a/lib/jinterface/test/nc_SUITE.erl
+++ b/lib/jinterface/test/nc_SUITE.erl
@@ -21,7 +21,6 @@
-include_lib("common_test/include/ct.hrl").
--include("test_server_line.hrl").
-define(VERSION_MAGIC, 131).
diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml
index 1bd52040a0..d4c9a48901 100644
--- a/lib/kernel/doc/src/code.xml
+++ b/lib/kernel/doc/src/code.xml
@@ -101,30 +101,6 @@
</section>
<section>
- <title>Code Path Cache</title>
- <p>The code server incorporates a code path cache. The cache
- functionality is disabled by default. To activate it, start
- the emulator with the command line flag <c>-code_path_cache</c>
- or call <c>code:rehash()</c>. When the cache is created (or
- updated), the code server searches for modules in the code path
- directories. This may take some time if the the code path is long.
- After the cache creation, the time for loading modules in a large
- system (one with a large directory structure) is significantly
- reduced compared to having the cache disabled. The code server
- is able to look up the location of a module from the cache in
- constant time instead of having to search through the code path
- directories.</p>
- <p>Application resource files (<c>.app</c> files) are also stored
- in the code path cache. This feature is used by the application
- controller (see
- <seealso marker="application">application(3)</seealso>) to load
- applications efficiently in large systems.</p>
- <p>Note that when the code path cache is created (or updated), any
- relative directory names in the code path are converted to
- absolute.</p>
- </section>
-
- <section>
<title>Loading of Code From Archive Files</title>
<warning><p>The support for loading of code from archive files is
@@ -733,13 +709,6 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]),
</desc>
</func>
<func>
- <name name="rehash" arity="0"/>
- <fsummary>Rehash or create code path cache</fsummary>
- <desc>
- <p>This function creates or rehashes the code path cache.</p>
- </desc>
- </func>
- <func>
<name name="where_is_file" arity="1"/>
<fsummary>Full name of a file located in the code path</fsummary>
<desc>
@@ -747,10 +716,7 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]),
arbitrary type. If found, the full name is returned.
<c>non_existing</c> is returned if the file cannot be found.
The function can be useful, for example, to locate
- application resource files. If the code path cache is used,
- the code server will efficiently read the full name from
- the cache, provided that <c><anno>Filename</anno></c> is an object code
- file or an <c>.app</c> file.</p>
+ application resource files.</p>
</desc>
</func>
<func>
diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml
index 5341a793ef..b625ddba5d 100644
--- a/lib/kernel/doc/src/notes.xml
+++ b/lib/kernel/doc/src/notes.xml
@@ -529,8 +529,7 @@
Erlang/OTP has been ported to the realtime operating
system OSE. The port supports both smp and non-smp
emulator. For details around the port and how to started
- see the User's Guide in the <seealso
- marker="ose:ose_intro">ose</seealso> application. </p>
+ see the User's Guide in the ose application. </p>
<p>
Note that not all parts of Erlang/OTP has been ported. </p>
<p>
diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml
index 682d4a2eac..165160a909 100644
--- a/lib/kernel/doc/src/os.xml
+++ b/lib/kernel/doc/src/os.xml
@@ -37,6 +37,7 @@
use these functions can be of help in enabling a program to run on
most platforms.</p>
</description>
+
<funcs>
<func>
<name name="cmd" arity="1"/>
@@ -210,6 +211,30 @@ format_utc_timestamp() ->
</desc>
</func>
<func>
+ <name name="perf_counter" arity="0"/>
+ <fsummary>Returns a performance counter</fsummary>
+ <desc>
+ <p>Returns the current performance counter value in <c>perf_counter</c>
+ <seealso marker="erts:erlang#type_time_unit">time unit</seealso>.
+ This is a highly optimized call that might not be traceable.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name name="perf_counter" arity="1"/>
+ <fsummary>Returns a performance counter</fsummary>
+ <desc><p>Returns a performance counter that can be used as a very fast and
+ high resolution timestamp. This counter is read directly from the hardware or operating
+ system with the same guarantees. This means that two consecutive calls
+ to the function are not guaranteed to be monotonic, though it most likely will be.
+ The performance counter till be converted to the resolution passed as an argument.</p>
+ <pre>1> <input>T1 = os:perf_counter(1000),receive after 10000 -> ok end,T2 = os:perf_counter(1000).</input>
+176525861
+2> <input>T2 - T1.</input>
+10004</pre>
+ </desc>
+ </func>
+ <func>
<name name="type" arity="0"/>
<fsummary>Return the OS family and, in some cases, OS name of the current operating system</fsummary>
<desc>
diff --git a/lib/kernel/doc/src/ref_man.xml.src b/lib/kernel/doc/src/ref_man.xml.src
deleted file mode 100644
index 7eb48a5f1d..0000000000
--- a/lib/kernel/doc/src/ref_man.xml.src
+++ /dev/null
@@ -1,68 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE application SYSTEM "application.dtd">
-
-<application xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>1996</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Kernel Reference Manual</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <description>
- <p>The <em>Kernel</em> application has all the code necessary to run
- the Erlang runtime system itself: file servers and code servers
- and so on.</p>
- </description>
- <xi:include href="kernel_app.xml"/>
- <xi:include href="application.xml"/>
- <xi:include href="auth.xml"/>
- <xi:include href="code.xml"/>
- <xi:include href="disk_log.xml"/>
- <xi:include href="erl_boot_server.xml"/>
- <xi:include href="erl_ddll.xml"/>
- <xi:include href="erl_prim_loader_stub.xml"/>
- <xi:include href="erlang_stub.xml"/>
- <xi:include href="error_handler.xml"/>
- <xi:include href="error_logger.xml"/>
- <xi:include href="file.xml"/>
- <xi:include href="gen_tcp.xml"/>
- <xi:include href="gen_udp.xml"/>
- <xi:include href="gen_sctp.xml"/>
- <xi:include href="global.xml"/>
- <xi:include href="global_group.xml"/>
- <xi:include href="heart.xml"/>
- <xi:include href="inet.xml"/>
- <xi:include href="inet_res.xml"/>
- <xi:include href="init_stub.xml"/>
- <xi:include href="net_adm.xml"/>
- <xi:include href="net_kernel.xml"/>
- <xi:include href="os.xml"/>
- <xi:include href="pg2.xml"/>
- <xi:include href="rpc.xml"/>
- <xi:include href="seq_trace.xml"/>
- <xi:include href="user.xml"/>
- <xi:include href="wrap_log_reader.xml"/>
- <xi:include href="zlib_stub.xml"/>
- <xi:include href="app.xml"/>
- <xi:include href="config.xml"/>
-</application>
diff --git a/lib/kernel/include/file.hrl b/lib/kernel/include/file.hrl
index 7cf033f7f5..36112bb040 100644
--- a/lib/kernel/include/file.hrl
+++ b/lib/kernel/include/file.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,37 +23,40 @@
%%--------------------------------------------------------------------------
-record(file_info,
- {size :: non_neg_integer(), % Size of file in bytes.
- type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink',
- access :: 'read' | 'write' | 'read_write' | 'none',
- atime :: file:date_time() | non_neg_integer(),
+ {size :: non_neg_integer() | 'undefined', % Size of file in bytes.
+ type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink'
+ | 'undefined',
+ access :: 'read' | 'write' | 'read_write' | 'none' | 'undefined',
+ atime :: file:date_time() | non_neg_integer() | 'undefined',
% The local time the file was last read:
% {{Year, Mon, Day}, {Hour, Min, Sec}}.
% atime, ctime, mtime may also be unix epochs()
- mtime :: file:date_time() | non_neg_integer(),
+ mtime :: file:date_time() | non_neg_integer() | 'undefined',
% The local time the file was last written.
- ctime :: file:date_time() | non_neg_integer(),
+ ctime :: file:date_time() | non_neg_integer() | 'undefined',
% The interpretation of this time field
% is dependent on operating system.
% On Unix it is the last time the file
% or the inode was changed. On Windows,
% it is the creation time.
- mode :: non_neg_integer(), % File permissions. On Windows,
+ mode :: non_neg_integer() | 'undefined',
+ % File permissions. On Windows,
% the owner permissions will be
% duplicated for group and user.
- links :: non_neg_integer(),
+ links :: non_neg_integer() | 'undefined',
% Number of links to the file (1 if the
% filesystem doesn't support links).
- major_device :: non_neg_integer(),
+ major_device :: non_neg_integer() | 'undefined',
% Identifies the file system (Unix),
% or the drive number (A: = 0, B: = 1)
% (Windows).
%% The following are Unix specific.
%% They are set to zero on other operating systems.
- minor_device :: non_neg_integer(), % Only valid for devices.
- inode :: non_neg_integer(), % Inode number for file.
- uid :: non_neg_integer(), % User id for owner.
- gid :: non_neg_integer()}). % Group id for owner.
+ minor_device :: non_neg_integer() | 'undefined',
+ % Only valid for devices.
+ inode :: non_neg_integer() | 'undefined', % Inode number for file.
+ uid :: non_neg_integer() | 'undefined', % User id for owner.
+ gid :: non_neg_integer() | 'undefined'}). % Group id for owner.
-record(file_descriptor,
diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl
index 7237550786..59e226df43 100644
--- a/lib/kernel/src/code.erl
+++ b/lib/kernel/src/code.erl
@@ -60,7 +60,7 @@
del_path/1,
replace_path/2,
rehash/0,
- start_link/0, start_link/1,
+ start_link/0,
which/1,
where_is_file/1,
where_is_file/2,
@@ -68,6 +68,8 @@
clash/0,
get_mode/0]).
+-deprecated({rehash,0,next_major_release}).
+
-export_type([load_error_rsn/0, load_ret/0]).
-include_lib("kernel/include/file.hrl").
@@ -294,7 +296,9 @@ replace_path(Name, Dir) when (is_atom(Name) orelse is_list(Name)),
call({replace_path,Name,Dir}).
-spec rehash() -> 'ok'.
-rehash() -> call(rehash).
+rehash() ->
+ cache_warning(),
+ ok.
-spec get_mode() -> 'embedded' | 'interactive'.
get_mode() -> call(get_mode).
@@ -302,15 +306,11 @@ get_mode() -> call(get_mode).
%%-----------------------------------------------------------------
call(Req) ->
- code_server:call(code_server, Req).
+ code_server:call(Req).
-spec start_link() -> {'ok', pid()} | {'error', 'crash'}.
start_link() ->
- start_link([stick]).
-
--spec start_link(Flags :: [atom()]) -> {'ok', pid()} | {'error', 'crash'}.
-start_link(Flags) ->
- do_start(Flags).
+ do_start().
%%-----------------------------------------------------------------
%% In the init phase, code must not use any modules not yet loaded,
@@ -322,35 +322,21 @@ start_link(Flags) ->
%% us, so the module is loaded.
%%-----------------------------------------------------------------
-do_start(Flags) ->
+do_start() ->
+ maybe_warn_for_cache(),
load_code_server_prerequisites(),
- Mode = get_mode(Flags),
- case init:get_argument(root) of
- {ok,[[Root0]]} ->
- Root = filename:join([Root0]), % Normalize. Use filename
- case code_server:start_link([Root,Mode]) of
- {ok,_Pid} = Ok2 ->
- if
- Mode =:= interactive ->
- case lists:member(stick, Flags) of
- true -> do_stick_dirs();
- _ -> ok
- end;
- true ->
- ok
- end,
- %% Quietly load native code for all modules loaded so far
- Architecture = erlang:system_info(hipe_architecture),
- load_native_code_for_all_loaded(Architecture),
- Ok2;
- Other ->
- Other
- end;
- Other ->
- error_logger:error_msg("Can not start code server ~w ~n", [Other]),
- {error, crash}
- end.
+ {ok,[[Root0]]} = init:get_argument(root),
+ Mode = start_get_mode(),
+ Root = filename:join([Root0]), % Normalize.
+ Res = code_server:start_link([Root,Mode]),
+
+ maybe_stick_dirs(Mode),
+
+ %% Quietly load native code for all modules loaded so far.
+ Architecture = erlang:system_info(hipe_architecture),
+ load_native_code_for_all_loaded(Architecture),
+ Res.
%% Make sure that all modules that the code_server process calls
%% (directly or indirectly) are loaded. Otherwise the code_server
@@ -370,6 +356,16 @@ load_code_server_prerequisites() ->
_ = [M = M:module_info(module) || M <- Needed],
ok.
+maybe_stick_dirs(interactive) ->
+ case init:get_argument(nostick) of
+ {ok,[[]]} ->
+ ok;
+ _ ->
+ do_stick_dirs()
+ end;
+maybe_stick_dirs(_) ->
+ ok.
+
do_stick_dirs() ->
do_s(compiler),
do_s(stdlib),
@@ -387,19 +383,12 @@ do_s(Lib) ->
ok
end.
-get_mode(Flags) ->
- case lists:member(embedded, Flags) of
- true ->
+start_get_mode() ->
+ case init:get_argument(mode) of
+ {ok,[["embedded"]]} ->
embedded;
- _Otherwise ->
- case init:get_argument(mode) of
- {ok,[["embedded"]]} ->
- embedded;
- {ok,[["minimal"]]} ->
- minimal;
- _Else ->
- interactive
- end
+ _ ->
+ interactive
end.
%% Find out which version of a particular module we would
@@ -453,30 +442,14 @@ which(File, Base, [Directory|Tail]) ->
Filename :: file:filename(),
Absname :: file:filename().
where_is_file(File) when is_list(File) ->
- case call({is_cached,File}) of
- no ->
- Path = get_path(),
- which(File, ".", Path);
- Dir ->
- filename:join(Dir, File)
- end.
+ Path = get_path(),
+ which(File, ".", Path).
-spec where_is_file(Path :: file:filename(), Filename :: file:filename()) ->
file:filename() | 'non_existing'.
where_is_file(Path, File) when is_list(Path), is_list(File) ->
- CodePath = get_path(),
- if
- Path =:= CodePath ->
- case call({is_cached, File}) of
- no ->
- which(File, ".", Path);
- Dir ->
- filename:join(Dir, File)
- end;
- true ->
- which(File, ".", Path)
- end.
+ which(File, ".", Path).
-spec set_primary_archive(ArchiveFile :: file:filename(),
ArchiveBin :: binary(),
@@ -554,6 +527,22 @@ has_ext(Ext, Extlen, File) ->
end.
%%%
+%%% Warning for deprecated code path cache.
+%%%
+
+maybe_warn_for_cache() ->
+ case init:get_argument(code_path_cache) of
+ {ok, _} ->
+ cache_warning();
+ error ->
+ ok
+ end.
+
+cache_warning() ->
+ W = "The code path cache functionality has been removed",
+ error_logger:warning_report(W).
+
+%%%
%%% Silently load native code for all modules loaded so far.
%%%
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index 614219794c..b52def8777 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -22,9 +22,7 @@
%% This file holds the server part of the code_server.
-export([start_link/1,
- call/2,
- system_continue/3,
- system_terminate/4,
+ call/1,
system_code_change/4,
error_msg/2, info_msg/2
]).
@@ -35,16 +33,18 @@
-define(ANY_NATIVE_CODE_LOADED, any_native_code_loaded).
--record(state, {supervisor,
- root,
- path,
- moddb,
- namedb,
- cache = no_cache,
- mode = interactive,
- on_load = []}).
+-type on_load_item() :: {reference(),module(),file:name_all(),[pid()]}.
+
+-record(state, {supervisor :: pid(),
+ root :: file:name_all(),
+ path :: [file:name_all()],
+ moddb :: ets:tab(),
+ namedb :: ets:tab(),
+ mode = interactive :: 'interactive' | 'embedded',
+ on_load = [] :: [on_load_item()]}).
-type state() :: #state{}.
+-spec start_link([term()]) -> {'ok', pid()}.
start_link(Args) ->
Ref = make_ref(),
Parent = self(),
@@ -59,7 +59,7 @@ start_link(Args) ->
%% Init the code_server process.
%% -----------------------------------------------------------
-init(Ref, Parent, [Root,Mode0]) ->
+init(Ref, Parent, [Root,Mode]) ->
register(?MODULE, self()),
process_flag(trap_exit, true),
@@ -70,12 +70,6 @@ init(Ref, Parent, [Root,Mode0]) ->
end, erlang:pre_loaded()),
ets:insert(Db, init:fetch_loaded()),
- Mode =
- case Mode0 of
- minimal -> interactive;
- _ -> Mode0
- end,
-
IPath =
case Mode of
interactive ->
@@ -89,24 +83,17 @@ init(Ref, Parent, [Root,Mode0]) ->
end,
Path = add_loader_path(IPath, Mode),
- State0 = #state{root = Root,
- path = Path,
- moddb = Db,
- namedb = init_namedb(Path),
- mode = Mode},
-
- State =
- case init:get_argument(code_path_cache) of
- {ok, _} ->
- create_cache(State0);
- error ->
- State0
- end,
+ State = #state{supervisor = Parent,
+ root = Root,
+ path = Path,
+ moddb = Db,
+ namedb = init_namedb(Path),
+ mode = Mode},
put(?ANY_NATIVE_CODE_LOADED, false),
Parent ! {Ref,{ok,self()}},
- loop(State#state{supervisor = Parent}).
+ loop(State).
get_user_lib_dirs() ->
case os:getenv("ERL_LIBS") of
@@ -142,8 +129,9 @@ split_paths([C|T], S, Path, Paths) ->
split_paths([], _S, Path, Paths) ->
lists:reverse(Paths, [lists:reverse(Path)]).
-call(Name, Req) ->
- Name ! {code_call, self(), Req},
+-spec call(term()) -> term().
+call(Req) ->
+ ?MODULE ! {code_call, self(), Req},
receive
{?MODULE, Reply} ->
Reply
@@ -255,59 +243,33 @@ handle_call({dir,Dir}, {_From,_Tag}, S) ->
Resp = do_dir(Root,Dir,S#state.namedb),
{reply,Resp,S};
-handle_call({load_file,Mod}, Caller, St) ->
- case modp(Mod) of
- false ->
- {reply,{error,badarg},St};
- true ->
- load_file(Mod, Caller, St)
- end;
+handle_call({load_file,Mod}, Caller, St) when is_atom(Mod) ->
+ load_file(Mod, Caller, St);
handle_call({add_path,Where,Dir0}, {_From,_Tag},
- #state{cache=Cache0,namedb=Namedb,path=Path0}=S) ->
- case Cache0 of
- no_cache ->
- {Resp,Path} = add_path(Where, Dir0, Path0, Namedb),
- {reply,Resp,S#state{path=Path}};
- _ ->
- Dir = absname(Dir0), %% Cache always expands the path
- {Resp,Path} = add_path(Where, Dir, Path0, Namedb),
- Cache = update_cache([Dir], Where, Cache0),
- {reply,Resp,S#state{path=Path,cache=Cache}}
- end;
+ #state{namedb=Namedb,path=Path0}=S) ->
+ {Resp,Path} = add_path(Where, Dir0, Path0, Namedb),
+ {reply,Resp,S#state{path=Path}};
handle_call({add_paths,Where,Dirs0}, {_From,_Tag},
- #state{cache=Cache0,namedb=Namedb,path=Path0}=S) ->
- case Cache0 of
- no_cache ->
- {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb),
- {reply,Resp,S#state{path=Path}};
- _ ->
- %% Cache always expands the path
- Dirs = [absname(Dir) || Dir <- Dirs0],
- {Resp,Path} = add_paths(Where, Dirs, Path0, Namedb),
- Cache=update_cache(Dirs,Where,Cache0),
- {reply,Resp,S#state{cache=Cache,path=Path}}
- end;
+ #state{namedb=Namedb,path=Path0}=S) ->
+ {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb),
+ {reply,Resp,S#state{path=Path}};
handle_call({set_path,PathList}, {_From,_Tag},
#state{path=Path0,namedb=Namedb}=S) ->
{Resp,Path,NewDb} = set_path(PathList, Path0, Namedb),
- {reply,Resp,rehash_cache(S#state{path=Path,namedb=NewDb})};
+ {reply,Resp,S#state{path=Path,namedb=NewDb}};
handle_call({del_path,Name}, {_From,_Tag},
#state{path=Path0,namedb=Namedb}=S) ->
{Resp,Path} = del_path(Name, Path0, Namedb),
- {reply,Resp,rehash_cache(S#state{path=Path})};
+ {reply,Resp,S#state{path=Path}};
handle_call({replace_path,Name,Dir}, {_From,_Tag},
#state{path=Path0,namedb=Namedb}=S) ->
{Resp,Path} = replace_path(Name, Dir, Path0, Namedb),
- {reply,Resp,rehash_cache(S#state{path=Path})};
-
-handle_call(rehash, {_From,_Tag}, S0) ->
- S = create_cache(S0),
- {reply,ok,S};
+ {reply,Resp,S#state{path=Path}};
handle_call(get_path, {_From,_Tag}, S) ->
{reply,S#state.path,S};
@@ -321,7 +283,7 @@ handle_call({load_abs,File,Mod}, Caller, S) when is_atom(Mod) ->
load_abs(File, Mod, Caller, S)
end;
-handle_call({load_binary,Mod,File,Bin}, Caller, S) ->
+handle_call({load_binary,Mod,File,Bin}, Caller, S) when is_atom(Mod) ->
do_load_binary(Mod, File, Bin, Caller, S);
handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) ->
@@ -337,59 +299,44 @@ handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) ->
Status = hipe_result_to_status(Result),
{reply,Status,S};
-handle_call({ensure_loaded,Mod0}, Caller, St0) ->
- Fun = fun (M, St) ->
- case erlang:module_loaded(M) of
- true ->
- {reply,{module,M},St};
- false when St#state.mode =:= interactive ->
- load_file(M, Caller, St);
- false ->
- {reply,{error,embedded},St}
- end
- end,
- do_mod_call(Fun, Mod0, {error,badarg}, St0);
-
-handle_call({delete,Mod0}, {_From,_Tag}, S) ->
- Fun = fun (M, St) ->
- case catch erlang:delete_module(M) of
- true ->
- ets:delete(St#state.moddb, M),
- {reply,true,St};
- _ ->
- {reply,false,St}
- end
- end,
- do_mod_call(Fun, Mod0, false, S);
+handle_call({ensure_loaded,Mod}, Caller, St) when is_atom(Mod) ->
+ case erlang:module_loaded(Mod) of
+ true ->
+ {reply,{module,Mod},St};
+ false when St#state.mode =:= interactive ->
+ load_file(Mod, Caller, St);
+ false ->
+ {reply,{error,embedded},St}
+ end;
-handle_call({purge,Mod0}, {_From,_Tag}, St0) ->
- do_mod_call(fun (M, St) ->
- {reply,do_purge(M),St}
- end, Mod0, false, St0);
+handle_call({delete,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ case catch erlang:delete_module(Mod) of
+ true ->
+ ets:delete(St#state.moddb, Mod),
+ {reply,true,St};
+ _ ->
+ {reply,false,St}
+ end;
-handle_call({soft_purge,Mod0}, {_From,_Tag}, St0) ->
- do_mod_call(fun (M, St) ->
- {reply,do_soft_purge(M),St}
- end, Mod0, true, St0);
+handle_call({purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ {reply,do_purge(Mod),St};
-handle_call({is_loaded,Mod0}, {_From,_Tag}, St0) ->
- do_mod_call(fun (M, St) ->
- {reply,is_loaded(M, St#state.moddb),St}
- end, Mod0, false, St0);
+handle_call({soft_purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ {reply,do_soft_purge(Mod),St};
+
+handle_call({is_loaded,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ {reply,is_loaded(Mod, St#state.moddb),St};
handle_call(all_loaded, {_From,_Tag}, S) ->
Db = S#state.moddb,
{reply,all_loaded(Db),S};
-handle_call({get_object_code,Mod0}, {_From,_Tag}, St0) ->
- Fun = fun(M, St) ->
- Path = St#state.path,
- case mod_to_bin(Path, atom_to_list(M)) of
- {_,Bin,FName} -> {reply,{M,Bin,FName},St};
- Error -> {reply,Error,St}
- end
- end,
- do_mod_call(Fun, Mod0, error, St0);
+handle_call({get_object_code,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ Path = St#state.path,
+ case mod_to_bin(Path, Mod) of
+ {_,Bin,FName} -> {reply,{Mod,Bin,FName},St};
+ Error -> {reply,Error,St}
+ end;
handle_call({is_sticky, Mod}, {_From,_Tag}, S) ->
Db = S#state.moddb,
@@ -398,9 +345,6 @@ handle_call({is_sticky, Mod}, {_From,_Tag}, S) ->
handle_call(stop,{_From,_Tag}, S) ->
{stop,normal,stopped,S};
-handle_call({is_cached,_File}, {_From,_Tag}, S=#state{cache=no_cache}) ->
- {reply, no, S};
-
handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, {_From,_Tag}, S=#state{mode=Mode}) ->
case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo, ParserFun) of
{ok, Files} ->
@@ -409,26 +353,6 @@ handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, {_From
{reply, Error, S}
end;
-handle_call({is_cached,File}, {_From,_Tag}, S=#state{cache=Cache}) ->
- ObjExt = objfile_extension(),
- Ext = filename:extension(File),
- Type = case Ext of
- ObjExt -> obj;
- ".app" -> app;
- _ -> undef
- end,
- if Type =:= undef ->
- {reply, no, S};
- true ->
- Key = {Type,list_to_atom(filename:rootname(File, Ext))},
- case ets:lookup(Cache, Key) of
- [] ->
- {reply, no, S};
- [{Key,Dir}] ->
- {reply, Dir, S}
- end
- end;
-
handle_call(get_mode, {_From,_Tag}, S=#state{mode=Mode}) ->
{reply, Mode, S};
@@ -436,80 +360,6 @@ handle_call(Other,{_From,_Tag}, S) ->
error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]),
{noreply,S}.
-do_mod_call(Action, Module, _Error, St) when is_atom(Module) ->
- Action(Module, St);
-do_mod_call(Action, Module, Error, St) ->
- try list_to_atom(Module) of
- Atom when is_atom(Atom) ->
- Action(Atom, St)
- catch
- error:badarg ->
- {reply,Error,St}
- end.
-
-%% --------------------------------------------------------------
-%% Cache functions
-%% --------------------------------------------------------------
-
-create_cache(St = #state{cache = no_cache}) ->
- Cache = ets:new(code_cache, [protected]),
- rehash_cache(Cache, St);
-create_cache(St) ->
- rehash_cache(St).
-
-rehash_cache(St = #state{cache = no_cache}) ->
- St;
-rehash_cache(St = #state{cache = OldCache}) ->
- ets:delete(OldCache),
- Cache = ets:new(code_cache, [protected]),
- rehash_cache(Cache, St).
-
-rehash_cache(Cache, St = #state{path = Path}) ->
- Exts = [{obj,objfile_extension()}, {app,".app"}],
- {Cache,NewPath} = locate_mods(lists:reverse(Path), first, Exts, Cache, []),
- St#state{cache = Cache, path=NewPath}.
-
-update_cache(Dirs, Where, Cache0) ->
- Exts = [{obj,objfile_extension()}, {app,".app"}],
- {Cache, _} = locate_mods(Dirs, Where, Exts, Cache0, []),
- Cache.
-
-locate_mods([Dir0|Path], Where, Exts, Cache, Acc) ->
- Dir = absname(Dir0), %% Cache always expands the path
- case erl_prim_loader:list_dir(Dir) of
- {ok, Files} ->
- Cache = filter_mods(Files, Where, Exts, Dir, Cache),
- locate_mods(Path, Where, Exts, Cache, [Dir|Acc]);
- error ->
- locate_mods(Path, Where, Exts, Cache, Acc)
- end;
-locate_mods([], _, _, Cache, Path) ->
- {Cache,Path}.
-
-filter_mods([File|Rest], Where, Exts, Dir, Cache) ->
- Ext = filename:extension(File),
- Root = list_to_atom(filename:rootname(File, Ext)),
- case lists:keyfind(Ext, 2, Exts) of
- {Type, _} ->
- Key = {Type,Root},
- case Where of
- first ->
- true = ets:insert(Cache, {Key,Dir});
- last ->
- case ets:lookup(Cache, Key) of
- [] ->
- true = ets:insert(Cache, {Key,Dir});
- _ ->
- ignore
- end
- end;
- false ->
- ok
- end,
- filter_mods(Rest, Where, Exts, Dir, Cache);
-filter_mods([], _, _, _, Cache) ->
- Cache.
-
%% --------------------------------------------------------------
%% Path handling functions.
%% --------------------------------------------------------------
@@ -1207,9 +1057,9 @@ add_paths(_,_,Path,_) ->
{ok,Path}.
do_load_binary(Module, File, Binary, Caller, St) ->
- case modp(Module) andalso modp(File) andalso is_binary(Binary) of
+ case modp(File) andalso is_binary(Binary) of
true ->
- case erlang:module_loaded(to_atom(Module)) of
+ case erlang:module_loaded(Module) of
true -> do_purge(Module);
false -> ok
end,
@@ -1233,21 +1083,10 @@ load_abs(File, Mod, Caller, St) ->
{reply,{error,nofile},St}
end.
-try_load_module(Mod, Dir, Caller, St) ->
- File = filename:append(Dir, to_list(Mod) ++
- objfile_extension()),
- case erl_prim_loader:get_file(File) of
- error ->
- {reply,error,St};
- {ok,Binary,FName} ->
- try_load_module(absname(FName), Mod, Binary, Caller, St)
- end.
-
try_load_module(File, Mod, Bin, {From,_}=Caller, St0) ->
- M = to_atom(Mod),
- case pending_on_load(M, From, St0) of
+ case pending_on_load(Mod, From, St0) of
no ->
- try_load_module_1(File, M, Bin, Caller, St0);
+ try_load_module_1(File, Mod, Bin, Caller, St0);
{yes,St} ->
{noreply,St}
end.
@@ -1266,9 +1105,10 @@ try_load_module_2(File, Mod, Bin, Caller, undefined, St) ->
try_load_module_3(File, Mod, Bin, Caller, undefined, St);
try_load_module_2(File, Mod, Bin, Caller, Architecture,
#state{moddb=Db}=St) ->
- case catch load_native_code(Mod, Bin, Architecture) of
+ case catch hipe_unified_loader:load_native_code(Mod, Bin, Architecture) of
{module,Mod} = Module ->
- ets:insert(Db, {Mod,File}),
+ put(?ANY_NATIVE_CODE_LOADED, true),
+ ets:insert(Db, {Mod,File}),
{reply,Module,St};
no_native ->
try_load_module_3(File, Mod, Bin, Caller, Architecture, St);
@@ -1291,26 +1131,6 @@ try_load_module_3(File, Mod, Bin, Caller, Architecture,
{reply,Error,St}
end.
-load_native_code(Mod, Bin, Architecture) ->
- %% During bootstrapping of Open Source Erlang, we don't have any hipe
- %% loader modules, but the Erlang emulator might be hipe enabled.
- %% Therefore we must test for that the loader modules are available
- %% before trying to to load native code.
- case erlang:module_loaded(hipe_unified_loader) of
- false ->
- no_native;
- true ->
- Result = hipe_unified_loader:load_native_code(Mod, Bin,
- Architecture),
- case Result of
- {module,_} ->
- put(?ANY_NATIVE_CODE_LOADED, true);
- _ ->
- ok
- end,
- Result
- end.
-
hipe_result_to_status(Result) ->
case Result of
{module,_} ->
@@ -1333,37 +1153,22 @@ int_list([H|T]) when is_integer(H) -> int_list(T);
int_list([_|_]) -> false;
int_list([]) -> true.
-load_file(Mod0, {From,_}=Caller, St0) ->
- Mod = to_atom(Mod0),
+load_file(Mod, {From,_}=Caller, St0) ->
case pending_on_load(Mod, From, St0) of
no -> load_file_1(Mod, Caller, St0);
{yes,St} -> {noreply,St}
end.
-load_file_1(Mod, Caller, #state{path=Path,cache=no_cache}=St) ->
+load_file_1(Mod, Caller, #state{path=Path}=St) ->
case mod_to_bin(Path, Mod) of
error ->
{reply,{error,nofile},St};
{Mod,Binary,File} ->
- try_load_module(File, Mod, Binary, Caller, St)
- end;
-load_file_1(Mod, Caller, #state{cache=Cache}=St0) ->
- Key = {obj,Mod},
- case ets:lookup(Cache, Key) of
- [] ->
- St = rehash_cache(St0),
- case ets:lookup(St#state.cache, Key) of
- [] ->
- {reply,{error,nofile},St};
- [{Key,Dir}] ->
- try_load_module(Mod, Dir, Caller, St)
- end;
- [{Key,Dir}] ->
- try_load_module(Mod, Dir, Caller, St0)
+ try_load_module_1(File, Mod, Binary, Caller, St)
end.
mod_to_bin([Dir|Tail], Mod) ->
- File = filename:append(Dir, to_list(Mod) ++ objfile_extension()),
+ File = filename:append(Dir, atom_to_list(Mod) ++ objfile_extension()),
case erl_prim_loader:get_file(File) of
error ->
mod_to_bin(Tail, Mod);
@@ -1416,243 +1221,6 @@ absname_vr([[X, $:]|Name], _, _AbsBase) ->
absname(filename:join(Name), Dcwd).
-%% do_purge(Module)
-%% Kill all processes running code from *old* Module, and then purge the
-%% module. Return true if any processes killed, else false.
-
-do_purge(Mod0) ->
- Mod = to_atom(Mod0),
- case erlang:check_old_code(Mod) of
- false ->
- false;
- true ->
- Res = check_proc_code(erlang:processes(), Mod, true),
- try
- erlang:purge_module(Mod)
- catch
- _:_ -> ignore
- end,
- Res
- end.
-
-%% do_soft_purge(Module)
-%% Purge old code only if no procs remain that run old code.
-%% Return true in that case, false if procs remain (in this
-%% case old code is not purged)
-
-do_soft_purge(Mod0) ->
- Mod = to_atom(Mod0),
- case erlang:check_old_code(Mod) of
- false ->
- true;
- true ->
- case check_proc_code(erlang:processes(), Mod, false) of
- false ->
- false;
- true ->
- try
- erlang:purge_module(Mod)
- catch
- _:_ -> ignore
- end,
- true
- end
- end.
-
-%%
-%% check_proc_code(Pids, Mod, Hard) - Send asynchronous
-%% requests to all processes to perform a check_process_code
-%% operation. Each process will check their own state and
-%% reply with the result. If 'Hard' equals
-%% - true, processes that refer 'Mod' will be killed. If
-%% any processes were killed true is returned; otherwise,
-%% false.
-%% - false, and any processes refer 'Mod', false will
-%% returned; otherwise, true.
-%%
-%% Requests will be sent to all processes identified by
-%% Pids at once, but without allowing GC to be performed.
-%% Check process code operations that are aborted due to
-%% GC need, will be restarted allowing GC. However, only
-%% ?MAX_CPC_GC_PROCS outstanding operation allowing GC at
-%% a time will be allowed. This in order not to blow up
-%% memory wise.
-%%
-%% We also only allow ?MAX_CPC_NO_OUTSTANDING_KILLS
-%% outstanding kills. This both in order to avoid flooding
-%% our message queue with 'DOWN' messages and limiting the
-%% amount of memory used to keep references to all
-%% outstanding kills.
-%%
-
-%% We maybe should allow more than two outstanding
-%% GC requests, but for now we play it safe...
--define(MAX_CPC_GC_PROCS, 2).
--define(MAX_CPC_NO_OUTSTANDING_KILLS, 10).
-
--record(cpc_static, {hard, module, tag}).
-
--record(cpc_kill, {outstanding = [],
- no_outstanding = 0,
- waiting = [],
- killed = false}).
-
-check_proc_code(Pids, Mod, Hard) ->
- Tag = erlang:make_ref(),
- CpcS = #cpc_static{hard = Hard,
- module = Mod,
- tag = Tag},
- check_proc_code(CpcS, cpc_init(CpcS, Pids, 0), 0, [], #cpc_kill{}, true).
-
-check_proc_code(#cpc_static{hard = true}, 0, 0, [],
- #cpc_kill{outstanding = [], waiting = [], killed = Killed},
- true) ->
- %% No outstanding requests. We did a hard check, so result is whether or
- %% not we killed any processes...
- Killed;
-check_proc_code(#cpc_static{hard = false}, 0, 0, [], _KillState, Success) ->
- %% No outstanding requests and we did a soft check...
- Success;
-check_proc_code(#cpc_static{hard = false, tag = Tag} = CpcS, NoReq0, NoGcReq0,
- [], _KillState, false) ->
- %% Failed soft check; just cleanup the remaining replies corresponding
- %% to the requests we've sent...
- {NoReq1, NoGcReq1} = receive
- {check_process_code, {Tag, _P, GC}, _Res} ->
- case GC of
- false -> {NoReq0-1, NoGcReq0};
- true -> {NoReq0, NoGcReq0-1}
- end
- end,
- check_proc_code(CpcS, NoReq1, NoGcReq1, [], _KillState, false);
-check_proc_code(#cpc_static{tag = Tag} = CpcS, NoReq0, NoGcReq0, NeedGC0,
- KillState0, Success) ->
-
- %% Check if we should request a GC operation
- {NoGcReq1, NeedGC1} = case NoGcReq0 < ?MAX_CPC_GC_PROCS of
- GcOpAllowed when GcOpAllowed == false;
- NeedGC0 == [] ->
- {NoGcReq0, NeedGC0};
- _ ->
- {NoGcReq0+1, cpc_request_gc(CpcS,NeedGC0)}
- end,
-
- %% Wait for a cpc reply or 'DOWN' message
- {NoReq1, NoGcReq2, Pid, Result, KillState1} = cpc_recv(Tag,
- NoReq0,
- NoGcReq1,
- KillState0),
-
- %% Check the result of the reply
- case Result of
- aborted ->
- %% Operation aborted due to the need to GC in order to
- %% determine if the process is referring the module.
- %% Schedule the operation for restart allowing GC...
- check_proc_code(CpcS, NoReq1, NoGcReq2, [Pid|NeedGC1], KillState1,
- Success);
- false ->
- %% Process not referring the module; done with this process...
- check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, KillState1,
- Success);
- true ->
- %% Process referring the module...
- case CpcS#cpc_static.hard of
- false ->
- %% ... and soft check. The whole operation failed so
- %% no point continuing; clean up and fail...
- check_proc_code(CpcS, NoReq1, NoGcReq2, [], KillState1,
- false);
- true ->
- %% ... and hard check; schedule kill of it...
- check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1,
- cpc_sched_kill(Pid, KillState1), Success)
- end;
- 'DOWN' ->
- %% Handled 'DOWN' message
- check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1,
- KillState1, Success)
- end.
-
-cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = []} = KillState) ->
- receive
- {check_process_code, {Tag, Pid, GC}, Res} ->
- cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
- end;
-cpc_recv(Tag, NoReq, NoGcReq,
- #cpc_kill{outstanding = [R0, R1, R2, R3, R4 | _]} = KillState) ->
- receive
- {'DOWN', R, process, _, _} when R == R0;
- R == R1;
- R == R2;
- R == R3;
- R == R4 ->
- cpc_handle_down(NoReq, NoGcReq, R, KillState);
- {check_process_code, {Tag, Pid, GC}, Res} ->
- cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
- end;
-cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = [R|_]} = KillState) ->
- receive
- {'DOWN', R, process, _, _} ->
- cpc_handle_down(NoReq, NoGcReq, R, KillState);
- {check_process_code, {Tag, Pid, GC}, Res} ->
- cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
- end.
-
-cpc_handle_down(NoReq, NoGcReq, R, #cpc_kill{outstanding = Rs,
- no_outstanding = N} = KillState) ->
- {NoReq, NoGcReq, undefined, 'DOWN',
- cpc_sched_kill_waiting(KillState#cpc_kill{outstanding = cpc_list_rm(R, Rs),
- no_outstanding = N-1})}.
-
-cpc_list_rm(R, [R|Rs]) ->
- Rs;
-cpc_list_rm(R0, [R1|Rs]) ->
- [R1|cpc_list_rm(R0, Rs)].
-
-cpc_handle_cpc(NoReq, NoGcReq, false, Pid, Res, KillState) ->
- {NoReq-1, NoGcReq, Pid, Res, KillState};
-cpc_handle_cpc(NoReq, NoGcReq, true, Pid, Res, KillState) ->
- {NoReq, NoGcReq-1, Pid, Res, KillState}.
-
-cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) ->
- KillState;
-cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs,
- no_outstanding = N,
- waiting = [P|Ps]} = KillState) ->
- R = erlang:monitor(process, P),
- exit(P, kill),
- KillState#cpc_kill{outstanding = [R|Rs],
- no_outstanding = N+1,
- waiting = Ps,
- killed = true}.
-
-cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState)
- when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS ->
- KillState#cpc_kill{waiting = [Pid|Pids]};
-cpc_sched_kill(Pid,
- #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) ->
- R = erlang:monitor(process, Pid),
- exit(Pid, kill),
- KillState#cpc_kill{outstanding = [R|Rs],
- no_outstanding = N+1,
- killed = true}.
-
-cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) ->
- erlang:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}},
- {allow_gc, AllowGc}]).
-
-cpc_request_gc(CpcS, [Pid|Pids]) ->
- cpc_request(CpcS, Pid, true),
- Pids.
-
-cpc_init(_CpcS, [], NoReqs) ->
- NoReqs;
-cpc_init(CpcS, [Pid|Pids], NoReqs) ->
- cpc_request(CpcS, Pid, false),
- cpc_init(CpcS, Pids, NoReqs+1).
-
-% end of check_proc_code() implementation.
is_loaded(M, Db) ->
case ets:lookup(Db, M) of
@@ -1660,6 +1228,14 @@ is_loaded(M, Db) ->
[] -> false
end.
+do_purge(Mod) ->
+ {_WasOld, DidKill} = erts_code_purger:purge(Mod),
+ DidKill.
+
+do_soft_purge(Mod) ->
+ erts_code_purger:soft_purge(Mod).
+
+
%% -------------------------------------------------------
%% The on_load functionality.
%% -------------------------------------------------------
@@ -1754,13 +1330,13 @@ strip_mod_info([{{sticky,_},_}|T], Acc) -> strip_mod_info(T, Acc);
strip_mod_info([H|T], Acc) -> strip_mod_info(T, [H|Acc]);
strip_mod_info([], Acc) -> Acc.
-% error_msg(Format) ->
-% error_msg(Format,[]).
+-spec error_msg(io:format(), [term()]) -> 'ok'.
error_msg(Format, Args) ->
Msg = {notify,{error, group_leader(), {self(), Format, Args}}},
error_logger ! Msg,
ok.
+-spec info_msg(io:format(), [term()]) -> 'ok'.
info_msg(Format, Args) ->
Msg = {notify,{info_msg, group_leader(), {self(), Format, Args}}},
error_logger ! Msg,
@@ -1774,6 +1350,3 @@ archive_extension() ->
to_list(X) when is_list(X) -> X;
to_list(X) when is_atom(X) -> atom_to_list(X).
-
-to_atom(X) when is_atom(X) -> X;
-to_atom(X) when is_list(X) -> list_to_atom(X).
diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl
index f5450f30af..9b44021872 100644
--- a/lib/kernel/src/disk_log.erl
+++ b/lib/kernel/src/disk_log.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1310,13 +1310,20 @@ compare_arg(_Attr, _Val, _A) ->
%% -> {ok, Res, log(), Cnt} | Error
do_open(A) ->
- L = #log{name = A#arg.name,
- filename = A#arg.file,
- size = A#arg.size,
- head = mk_head(A#arg.head, A#arg.format),
- mode = A#arg.mode,
- version = A#arg.version},
- do_open2(L, A).
+ #arg{type = Type, format = Format, name = Name, head = Head0,
+ file = FName, repair = Repair, size = Size, mode = Mode,
+ version = V} = A,
+ Head = mk_head(Head0, Format),
+ case do_open2(Type, Format, Name, FName, Repair, Size, Mode, Head, V) of
+ {ok, Ret, Extra, FormatType, NoItems} ->
+ L = #log{name = Name, type = Type, format = Format,
+ filename = FName, size = Size,
+ format_type = FormatType, head = Head, mode = Mode,
+ version = V, extra = Extra},
+ {ok, Ret, L, NoItems};
+ Error ->
+ Error
+ end.
mk_head({head, Term}, internal) -> {ok, term_to_binary(Term)};
mk_head({head, Bytes}, external) -> {ok, check_bytes(Bytes)};
@@ -1432,57 +1439,44 @@ do_inc_wrap_file(L) ->
%%-----------------------------------------------------------------
%% -> {ok, Reply, log(), Cnt} | Error
%% Note: the header is always written, even if the log size is too small.
-do_open2(L, #arg{type = halt, format = internal, name = Name,
- file = FName, repair = Repair, size = Size, mode = Mode}) ->
- case catch disk_log_1:int_open(FName, Repair, Mode, L#log.head) of
+do_open2(halt, internal, Name, FName, Repair, Size, Mode, Head, _V) ->
+ case catch disk_log_1:int_open(FName, Repair, Mode, Head) of
{ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} ->
Halt = #halt{fdc = FdC, curB = FileSize, size = Size},
- {ok, {ok, Name}, L#log{format_type = halt_int, extra = Halt},
- NoItems};
+ {ok, {ok, Name}, Halt, halt_int, NoItems};
{repaired, FdC, Rec, Bad, FileSize} ->
Halt = #halt{fdc = FdC, curB = FileSize, size = Size},
{ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}},
- L#log{format_type = halt_int, extra = Halt},
- Rec};
+ Halt, halt_int, Rec};
Error ->
Error
end;
-do_open2(L, #arg{type = wrap, format = internal, size = {MaxB, MaxF},
- name = Name, repair = Repair, file = FName, mode = Mode,
- version = V}) ->
+do_open2(wrap, internal, Name, FName, Repair, Size, Mode, Head, V) ->
+ {MaxB, MaxF} = Size,
case catch
- disk_log_1:mf_int_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of
+ disk_log_1:mf_int_open(FName, MaxB, MaxF, Repair, Mode, Head, V) of
{ok, Handle, Cnt} ->
- {ok, {ok, Name}, L#log{type = wrap,
- format_type = wrap_int,
- extra = Handle}, Cnt};
+ {ok, {ok, Name}, Handle, wrap_int, Cnt};
{repaired, Handle, Rec, Bad, Cnt} ->
{ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}},
- L#log{type = wrap, format_type = wrap_int, extra = Handle}, Cnt};
+ Handle, wrap_int, Cnt};
Error ->
Error
end;
-do_open2(L, #arg{type = halt, format = external, file = FName, name = Name,
- size = Size, repair = Repair, mode = Mode}) ->
- case catch disk_log_1:ext_open(FName, Repair, Mode, L#log.head) of
+do_open2(halt, external, Name, FName, Repair, Size, Mode, Head, _V) ->
+ case catch disk_log_1:ext_open(FName, Repair, Mode, Head) of
{ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} ->
Halt = #halt{fdc = FdC, curB = FileSize, size = Size},
- {ok, {ok, Name},
- L#log{format_type = halt_ext, format = external, extra = Halt},
- NoItems};
+ {ok, {ok, Name}, Halt, halt_ext, NoItems};
Error ->
Error
end;
-do_open2(L, #arg{type = wrap, format = external, size = {MaxB, MaxF},
- name = Name, file = FName, repair = Repair, mode = Mode,
- version = V}) ->
+do_open2(wrap, external, Name, FName, Repair, Size, Mode, Head, V) ->
+ {MaxB, MaxF} = Size,
case catch
- disk_log_1:mf_ext_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of
+ disk_log_1:mf_ext_open(FName, MaxB, MaxF, Repair, Mode, Head, V) of
{ok, Handle, Cnt} ->
- {ok, {ok, Name}, L#log{type = wrap,
- format_type = wrap_ext,
- extra = Handle,
- format = external}, Cnt};
+ {ok, {ok, Name}, Handle, wrap_ext, Cnt};
Error ->
Error
end.
diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl
index 6c0aea070f..3262d979ee 100644
--- a/lib/kernel/src/disk_log.hrl
+++ b/lib/kernel/src/disk_log.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -152,8 +152,8 @@
users = 0 :: non_neg_integer(), %% non-linked users
filename :: file:filename(), %% real name of the file
owners = [] :: [{pid(), boolean()}],%% [{pid, notify}]
- type = halt :: dlog_type(),
- format = internal :: dlog_format(),
+ type :: dlog_type(),
+ format :: dlog_format(),
format_type :: dlog_format_type(),
head = none, %% none | {head, H} | {M,F,A}
%% called when wraplog wraps
diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl
index eb231fd155..30a9457bb3 100644
--- a/lib/kernel/src/error_logger.erl
+++ b/lib/kernel/src/error_logger.erl
@@ -435,5 +435,82 @@ add_node(X, Pid) ->
%% Can't do io_lib:format
-display2(Tag,F,A) ->
- erlang:display({error_logger,Tag,F,A}).
+display2({{_Y,_Mo,_D},{_H,_Mi,_S}} = Date, F, A) ->
+ display_date(Date),
+ display3(string_p(F), F, A).
+
+display_date({{Y,Mo,D},{H,Mi,S}}) ->
+ erlang:display_string(
+ integer_to_list(Y) ++ "-" ++
+ two_digits(Mo) ++ "-" ++
+ two_digits(D) ++ " " ++
+ two_digits(H) ++ ":" ++
+ two_digits(Mi) ++ ":" ++
+ two_digits(S) ++ " ").
+
+two_digits(N) when 0 =< N, N =< 9 ->
+ [$0, $0 + N];
+two_digits(N) ->
+ integer_to_list(N).
+
+display3(true, F, A) ->
+ %% Format string with arguments
+ erlang:display_string(F ++ "\n"),
+ [begin
+ erlang:display_string("\t"),
+ erlang:display(Arg)
+ end || Arg <- A],
+ ok;
+display3(false, Atom, A) when is_atom(Atom) ->
+ %% The widest atom seems to be 'supervisor_report' at 17.
+ ColumnWidth = 20,
+ AtomString = atom_to_list(Atom),
+ AtomLength = length(AtomString),
+ Padding = lists:duplicate(ColumnWidth - AtomLength, $\s),
+ erlang:display_string(AtomString ++ Padding),
+ display4(A);
+display3(_, F, A) ->
+ erlang:display({F, A}).
+
+display4([A, []]) ->
+ %% Not sure why crash reports look like this.
+ display4(A);
+display4(A = [_|_]) ->
+ case lists:all(fun({Key,_Value}) -> is_atom(Key); (_) -> false end, A) of
+ true ->
+ erlang:display_string("\n"),
+ lists:foreach(
+ fun({Key, Value}) ->
+ erlang:display_string(
+ " " ++
+ atom_to_list(Key) ++
+ ": "),
+ erlang:display(Value)
+ end, A);
+ false ->
+ erlang:display(A)
+ end;
+display4(A) ->
+ erlang:display(A).
+
+string_p([]) ->
+ false;
+string_p(Term) ->
+ string_p1(Term).
+
+string_p1([H|T]) when is_integer(H), H >= $\s, H < 255 ->
+ string_p1(T);
+string_p1([$\n|T]) -> string_p1(T);
+string_p1([$\r|T]) -> string_p1(T);
+string_p1([$\t|T]) -> string_p1(T);
+string_p1([$\v|T]) -> string_p1(T);
+string_p1([$\b|T]) -> string_p1(T);
+string_p1([$\f|T]) -> string_p1(T);
+string_p1([$\e|T]) -> string_p1(T);
+string_p1([H|T]) when is_list(H) ->
+ case string_p1(H) of
+ true -> string_p1(T);
+ _ -> false
+ end;
+string_p1([]) -> true;
+string_p1(_) -> false.
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index 39308c0043..8e2b5ad214 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -34,7 +34,8 @@
-export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2,
dump_monitors/1, dump_links/1, flat_size/1,
get_internal_state/1, instructions/0, lock_counters/1,
- map_info/1, same/2, set_internal_state/2]).
+ map_info/1, same/2, set_internal_state/2,
+ size_shared/1, copy_shared/1]).
-spec breakpoint(MFA, Flag) -> non_neg_integer() when
MFA :: {Module :: module(),
@@ -86,6 +87,18 @@ dump_links(_) ->
flat_size(_) ->
erlang:nif_error(undef).
+-spec size_shared(Term) -> non_neg_integer() when
+ Term :: term().
+
+size_shared(_) ->
+ erlang:nif_error(undef).
+
+-spec copy_shared(Term) -> term() when
+ Term :: term().
+
+copy_shared(_) ->
+ erlang:nif_error(undef).
+
-spec get_internal_state(W) -> term() when
W :: reds_left | node_and_dist_references | monitoring_nodes
| next_pid | 'DbTable_words' | check_io_debug
@@ -230,7 +243,7 @@ map_size(Map,Seen0,Sum0) ->
%% is not allowed to leak anywhere. They are only allowed in
%% containers (cons cells and tuples, not maps), in gc and
%% in erts_debug:same/2
- case erts_internal:map_type(Map) of
+ case erts_internal:term_type(Map) of
flatmap ->
Kt = erts_internal:map_to_tuple_keys(Map),
Vs = maps:values(Map),
diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl
index 2be1efaf24..0c73ead7c5 100644
--- a/lib/kernel/src/global.erl
+++ b/lib/kernel/src/global.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -459,17 +459,17 @@ init([]) ->
no_trace
end,
+ Ca = case init:get_argument(connect_all) of
+ {ok, [["false"]]} ->
+ false;
+ _ ->
+ true
+ end,
S = #state{the_locker = start_the_locker(DoTrace),
trace = T0,
- the_registrar = start_the_registrar()},
- S1 = trace_message(S, {init, node()}, []),
-
- case init:get_argument(connect_all) of
- {ok, [["false"]]} ->
- {ok, S1#state{connect_all = false}};
- _ ->
- {ok, S1#state{connect_all = true}}
- end.
+ the_registrar = start_the_registrar(),
+ connect_all = Ca},
+ {ok, trace_message(S, {init, node()}, [])}.
%%-----------------------------------------------------------------
%% Connection algorithm
@@ -2068,23 +2068,17 @@ get_known() ->
gen_server:call(global_name_server, get_known, infinity).
random_sleep(Times) ->
- case (Times rem 10) of
- 0 -> erase(random_seed);
- _ -> ok
- end,
- case get(random_seed) of
- undefined ->
- _ = random:seed(erlang:phash2([erlang:node()]),
- erlang:monotonic_time(),
- erlang:unique_integer()),
- ok;
- _ -> ok
- end,
+ _ = case Times rem 10 of
+ 0 ->
+ _ = rand:seed(exsplus);
+ _ ->
+ ok
+ end,
%% First time 1/4 seconds, then doubling each time up to 8 seconds max.
Tmax = if Times > 5 -> 8000;
true -> ((1 bsl Times) * 1000) div 8
end,
- T = random:uniform(Tmax),
+ T = rand:uniform(Tmax),
?trace({random_sleep, {me,self()}, {times,Times}, {t,T}, {tmax,Tmax}}),
receive after T -> ok end.
diff --git a/lib/kernel/src/global_group.erl b/lib/kernel/src/global_group.erl
index 848df13c39..e71f83f9d3 100644
--- a/lib/kernel/src/global_group.erl
+++ b/lib/kernel/src/global_group.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1998-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.
@@ -273,7 +273,7 @@ init([]) ->
{ok, #state{publish_type = PT, group_publish_type = PubTpGrp,
sync_state = synced, group_name = DefGroupName,
no_contact = lists:sort(DefNodes),
- other_grps = DefOther}}
+ other_grps = DefOther, connect_all = Ca}}
end.
diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl
index 803fae846e..a0d5344f11 100644
--- a/lib/kernel/src/inet_config.erl
+++ b/lib/kernel/src/inet_config.erl
@@ -188,9 +188,6 @@ do_load_resolv({win32,Type}, longnames) ->
win32_load_from_registry(Type),
inet_db:set_lookup([native]);
-do_load_resolv({ose,_}, _) ->
- inet_db:set_lookup([file]);
-
do_load_resolv(_, _) ->
inet_db:set_lookup([native]).
diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl
index 5f33f25a0d..40544da6c3 100644
--- a/lib/kernel/src/kernel.erl
+++ b/lib/kernel/src/kernel.erl
@@ -98,7 +98,7 @@ init([]) ->
{kernel_config, start_link, []},
permanent, 2000, worker, [kernel_config]},
Code = {code_server,
- {code, start_link, get_code_args()},
+ {code, start_link, []},
permanent, 2000, worker, [code]},
File = {file_server_2,
{file_server, start_link, []},
@@ -158,12 +158,6 @@ init(safe) ->
{ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}.
-get_code_args() ->
- case init:get_argument(nostick) of
- {ok, [[]]} -> [[nostick]];
- _ -> []
- end.
-
start_dist_ac() ->
Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}],
case application:get_env(kernel, start_dist_ac) of
diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl
index 3330b38d84..4947088635 100644
--- a/lib/kernel/src/os.erl
+++ b/lib/kernel/src/os.erl
@@ -27,7 +27,9 @@
%%% BIFs
--export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, system_time/0, system_time/1,
+-export([getenv/0, getenv/1, getenv/2, getpid/0,
+ perf_counter/0, perf_counter/1,
+ putenv/2, system_time/0, system_time/1,
timestamp/0, unsetenv/1]).
-spec getenv() -> [string()].
@@ -60,6 +62,18 @@ getenv(VarName, DefaultValue) ->
getpid() ->
erlang:nif_error(undef).
+-spec perf_counter() -> Counter when
+ Counter :: integer().
+
+perf_counter() ->
+ erlang:nif_error(undef).
+
+-spec perf_counter(Unit) -> integer() when
+ Unit :: erlang:time_unit().
+
+perf_counter(Unit) ->
+ erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit).
+
-spec putenv(VarName, Value) -> true when
VarName :: string(),
Value :: string().
@@ -93,7 +107,7 @@ unsetenv(_) ->
%%% End of BIFs
-spec type() -> {Osfamily, Osname} when
- Osfamily :: unix | win32 | ose,
+ Osfamily :: unix | win32,
Osname :: atom().
type() ->
@@ -212,174 +226,33 @@ extensions() ->
Command :: atom() | io_lib:chars().
cmd(Cmd) ->
validate(Cmd),
- Bytes = case type() of
- {unix, _} ->
- unix_cmd(Cmd);
- {win32, Wtype} ->
- Command0 = case {os:getenv("COMSPEC"),Wtype} of
- {false,windows} -> lists:concat(["command.com /c", Cmd]);
- {false,_} -> lists:concat(["cmd /c", Cmd]);
- {Cspec,_} -> lists:concat([Cspec," /c",Cmd])
- end,
- %% open_port/2 awaits string() in Command, but io_lib:chars() can be
- %% deep lists according to io_lib module description.
- Command = lists:flatten(Command0),
- Port = open_port({spawn, Command}, [stream, in, eof, hide]),
- get_data(Port, [])
- end,
- String = unicode:characters_to_list(list_to_binary(Bytes)),
+ {SpawnCmd, SpawnOpts, SpawnInput} = mk_cmd(os:type(), Cmd),
+ Port = open_port({spawn, SpawnCmd}, [binary, stderr_to_stdout,
+ stream, in, eof, hide | SpawnOpts]),
+ true = port_command(Port, SpawnInput),
+ Bytes = get_data(Port, []),
+ String = unicode:characters_to_list(Bytes),
if %% Convert to unicode list if possible otherwise return bytes
is_list(String) -> String;
- true -> Bytes
- end.
-
-unix_cmd(Cmd) ->
- Tag = make_ref(),
- {Pid,Mref} = erlang:spawn_monitor(
- fun() ->
- process_flag(trap_exit, true),
- Port = start_port(),
- erlang:port_command(Port, mk_cmd(Cmd)),
- exit({Tag,unix_get_data(Port)})
- end),
- receive
- {'DOWN',Mref,_,Pid,{Tag,Result}} ->
- Result;
- {'DOWN',Mref,_,Pid,Reason} ->
- exit(Reason)
+ true -> binary_to_list(Bytes)
end.
-%% The -s flag implies that only the positional parameters are set,
-%% and the commands are read from standard input. We set the
-%% $1 parameter for easy identification of the resident shell.
-%%
--define(ROOT, "/").
--define(ROOT_ANDROID, "/system").
--define(SHELL, "bin/sh -s unix:cmd 2>&1").
--define(PORT_CREATOR_NAME, os_cmd_port_creator).
-
-%%
-%% Serializing open_port through a process to avoid smp lock contention
-%% when many concurrent os:cmd() want to do vfork (OTP-7890).
-%%
--spec start_port() -> port().
-start_port() ->
- Ref = make_ref(),
- Request = {Ref,self()},
- {Pid, Mon} = case whereis(?PORT_CREATOR_NAME) of
- undefined ->
- spawn_monitor(fun() ->
- start_port_srv(Request)
- end);
- P ->
- P ! Request,
- M = erlang:monitor(process, P),
- {P, M}
- end,
- receive
- {Ref, Port} when is_port(Port) ->
- erlang:demonitor(Mon, [flush]),
- Port;
- {Ref, Error} ->
- erlang:demonitor(Mon, [flush]),
- exit(Error);
- {'DOWN', Mon, process, Pid, _Reason} ->
- start_port()
- end.
-
-start_port_srv(Request) ->
- %% We don't want a group leader of some random application. Use
- %% kernel_sup's group leader.
- {group_leader, GL} = process_info(whereis(kernel_sup),
- group_leader),
- true = group_leader(GL, self()),
- process_flag(trap_exit, true),
- StayAlive = try register(?PORT_CREATOR_NAME, self())
- catch
- error:_ -> false
- end,
- start_port_srv_handle(Request),
- case StayAlive of
- true -> start_port_srv_loop();
- false -> exiting
- end.
-
-start_port_srv_handle({Ref,Client}) ->
- Path = case lists:reverse(erlang:system_info(system_architecture)) of
- % androideabi
- "ibaediordna" ++ _ -> filename:join([?ROOT_ANDROID, ?SHELL]);
- _ -> filename:join([?ROOT, ?SHELL])
- end,
- Reply = try open_port({spawn, Path},[stream]) of
- Port when is_port(Port) ->
- (catch port_connect(Port, Client)),
- unlink(Port),
- Port
- catch
- error:Reason ->
- {Reason,erlang:get_stacktrace()}
- end,
- Client ! {Ref,Reply},
- ok.
-
-start_port_srv_loop() ->
- receive
- {Ref, Client} = Request when is_reference(Ref),
- is_pid(Client) ->
- start_port_srv_handle(Request);
- _Junk ->
- ok
- end,
- start_port_srv_loop().
-
-%%
-%% unix_get_data(Port) -> Result
-%%
-unix_get_data(Port) ->
- unix_get_data(Port, []).
-
-unix_get_data(Port, Sofar) ->
- receive
- {Port,{data, Bytes}} ->
- case eot(Bytes) of
- {done, Last} ->
- lists:flatten([Sofar|Last]);
- more ->
- unix_get_data(Port, [Sofar|Bytes])
- end;
- {'EXIT', Port, _} ->
- lists:flatten(Sofar)
- end.
-
-%%
-%% eot(String) -> more | {done, Result}
-%%
-eot(Bs) ->
- eot(Bs, []).
-
-eot([4| _Bs], As) ->
- {done, lists:reverse(As)};
-eot([B| Bs], As) ->
- eot(Bs, [B| As]);
-eot([], _As) ->
- more.
-
-%%
-%% mk_cmd(Cmd) -> {ok, ShellCommandString} | {error, ErrorString}
-%%
-%% We do not allow any input to Cmd (hence commands that want
-%% to read from standard input will return immediately).
-%% Standard error is redirected to standard output.
-%%
-%% We use ^D (= EOT = 4) to mark the end of the stream.
-%%
-mk_cmd(Cmd) when is_atom(Cmd) -> % backward comp.
- mk_cmd(atom_to_list(Cmd));
-mk_cmd(Cmd) ->
- %% We insert a new line after the command, in case the command
- %% contains a comment character.
- [$(, unicode:characters_to_binary(Cmd), "\n) </dev/null; echo \"\^D\"\n"].
-
+mk_cmd({win32,Wtype}, Cmd) ->
+ Command = case {os:getenv("COMSPEC"),Wtype} of
+ {false,windows} -> lists:concat(["command.com /c", Cmd]);
+ {false,_} -> lists:concat(["cmd /c", Cmd]);
+ {Cspec,_} -> lists:concat([Cspec," /c",Cmd])
+ end,
+ {Command, [], []};
+mk_cmd(OsType,Cmd) when is_atom(Cmd) ->
+ mk_cmd(OsType, atom_to_list(Cmd));
+mk_cmd(_,Cmd) ->
+ %% Have to send command in like this in order to make sh commands like
+ %% cd and ulimit available
+ {"/bin/sh -s unix:cmd", [out],
+ %% We insert a new line after the command, in case the command
+ %% contains a comment character.
+ ["(", unicode:characters_to_binary(Cmd), "\n); exit\n"]}.
validate(Atom) when is_atom(Atom) ->
ok;
@@ -397,7 +270,7 @@ validate1([]) ->
get_data(Port, Sofar) ->
receive
{Port, {data, Bytes}} ->
- get_data(Port, [Sofar|Bytes]);
+ get_data(Port, [Sofar,Bytes]);
{Port, eof} ->
Port ! {self(), close},
receive
@@ -410,5 +283,5 @@ get_data(Port, Sofar) ->
after 1 -> % force context switch
ok
end,
- lists:flatten(Sofar)
+ iolist_to_binary(Sofar)
end.
diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile
index 9e972b4f95..ba40dd3168 100644
--- a/lib/kernel/test/Makefile
+++ b/lib/kernel/test/Makefile
@@ -112,7 +112,7 @@ RELSYSDIR = $(RELEASE_PATH)/kernel_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl
index 0c198b90ae..0ff512bb6e 100644
--- a/lib/kernel/test/application_SUITE.erl
+++ b/lib/kernel/test/application_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(application_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
diff --git a/lib/kernel/test/bif_SUITE.erl b/lib/kernel/test/bif_SUITE.erl
index dd3010567a..284ca8f377 100644
--- a/lib/kernel/test/bif_SUITE.erl
+++ b/lib/kernel/test/bif_SUITE.erl
@@ -38,7 +38,7 @@
-export([init_per_testcase/2, end_per_testcase/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/kernel/test/cleanup.erl b/lib/kernel/test/cleanup.erl
index 7eb0a9e140..7f623b9fc3 100644
--- a/lib/kernel/test/cleanup.erl
+++ b/lib/kernel/test/cleanup.erl
@@ -21,7 +21,7 @@
-export([all/0,groups/0,init_per_group/2,end_per_group/2, cleanup/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
all() ->
[cleanup].
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 2b77ec8972..cf8863fcd0 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(code_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_group/2,end_per_group/2]).
-export([set_path/1, get_path/1, add_path/1, add_paths/1, del_path/1,
@@ -30,8 +30,7 @@
upgrade/1,
sticky_dir/1, pa_pz_option/1, add_del_path/1,
dir_disappeared/1, ext_mod_dep/1, clash/1,
- load_cached/1, start_node_with_cache/1, add_and_rehash/1,
- where_is_file_cached/1, where_is_file_no_cache/1,
+ where_is_file/1,
purge_stacktrace/1, mult_lib_roots/1, bad_erl_libs/1,
code_archive/1, code_archive2/1, on_load/1, on_load_binary/1,
on_load_embedded/1, on_load_errors/1, big_boot_embedded/1,
@@ -56,9 +55,8 @@ all() ->
load_binary, dir_req, object_code, set_path_file,
upgrade,
sticky_dir, pa_pz_option, add_del_path, dir_disappeared,
- ext_mod_dep, clash, load_cached, start_node_with_cache,
- add_and_rehash, where_is_file_no_cache,
- where_is_file_cached, purge_stacktrace, mult_lib_roots,
+ ext_mod_dep, clash, where_is_file,
+ purge_stacktrace, mult_lib_roots,
bad_erl_libs, code_archive, code_archive2, on_load,
on_load_binary, on_load_embedded, on_load_errors,
big_boot_embedded, native_early_modules, get_mode].
@@ -383,8 +381,23 @@ purge(Config) when is_list(Config) ->
purge_many_exits(Config) when is_list(Config) ->
OldFlag = process_flag(trap_exit, true),
+
code:purge(code_b_test),
{'EXIT',_} = (catch code:purge({})),
+
+ CodePurgeF = fun(M, Exp) -> Exp = code:purge(M) end,
+ purge_many_exits_do(CodePurgeF),
+
+ %% Let's repeat test for erlang:purge_module as it does the same thing
+ %% now in erts-8.0 (except for return value).
+ ErlangPurgeF = fun(M, _Exp) -> erlang:purge_module(M) end,
+ purge_many_exits_do(ErlangPurgeF),
+
+ process_flag(trap_exit, OldFlag),
+ ok.
+
+
+purge_many_exits_do(PurgeF) ->
false = code:purge(code_b_test),
TPids = lists:map(fun (_) ->
{code_b_test:do_spawn(),
@@ -403,7 +416,7 @@ purge_many_exits(Config) when is_list(Config) ->
false = code_b_test:check_exit(Pid1),
true = erlang:is_process_alive(Pid2)
end, TPids),
- true = code:purge(code_b_test),
+ PurgeF(code_b_test, true),
lists:foreach(fun ({Pid1, Pid2}) ->
false = erlang:is_process_alive(Pid1),
true = code_b_test:check_exit(Pid1),
@@ -412,9 +425,7 @@ purge_many_exits(Config) when is_list(Config) ->
end, TPids),
lists:foreach(fun ({_Pid1, Pid2}) ->
receive {'EXIT', Pid2, _} -> ok end
- end, TPids),
- process_flag(trap_exit, OldFlag),
- ok.
+ end, TPids).
soft_purge(suite) -> [];
@@ -670,13 +681,9 @@ add_del_path(Config) when is_list(Config) ->
clash(Config) when is_list(Config) ->
DDir = ?config(data_dir,Config)++"clash/",
P = code:get_path(),
- [TestServerPath|_] = [Path || Path <- code:get_path(),
- re:run(Path,"test_server/?$",[unicode]) /= nomatch],
%% test non-clashing entries
- %% remove TestServerPath to prevent clash with test-server path
- true = code:del_path(TestServerPath),
true = code:add_path(DDir++"foobar-0.1/ebin"),
true = code:add_path(DDir++"zork-0.8/ebin"),
test_server:capture_start(),
@@ -688,8 +695,6 @@ clash(Config) when is_list(Config) ->
%% test clashing entries
- %% remove TestServerPath to prevent clash with test-server path
- true = code:del_path(TestServerPath),
true = code:add_path(DDir++"foobar-0.1/ebin"),
true = code:add_path(DDir++"foobar-0.1.ez/foobar-0.1/ebin"),
test_server:capture_start(),
@@ -702,9 +707,7 @@ clash(Config) when is_list(Config) ->
%% test "Bad path can't read"
- %% remove TestServerPath to prevent clash with test-server path
Priv = ?config(priv_dir, Config),
- true = code:del_path(TestServerPath),
TmpEzFile = Priv++"foobar-0.tmp.ez",
{ok, _} = file:copy(DDir++"foobar-0.1.ez", TmpEzFile),
true = code:add_path(TmpEzFile++"/foobar-0.1/ebin"),
@@ -769,6 +772,7 @@ analyse([], [This={M,F,A}|Path], Visited, ErrCnt0) ->
OK = [erlang, os, prim_file, erl_prim_loader, init, ets,
code_server, lists, lists_sort, unicode, binary, filename,
gb_sets, gb_trees, hipe_unified_loader, hipe_bifs,
+ erts_code_purger,
prim_zip, zlib],
ErrCnt1 =
case lists:member(M, OK) or erlang:is_builtin(M,F,A) of
@@ -839,18 +843,7 @@ check_funs({'$M_EXPR','$F_EXPR',1},
{code_server,start_link,1}]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',1},
[{lists,filter,2},
- {code_server,try_archive_subdirs,3},
- {code_server,all_archive_subdirs,1},
- {code_server,archive_subdirs,1},
- {code_server,insert_name,3},
- {code_server,replace_name,2},
- {code_server,update,2},
- {code_server,maybe_update,2},
- {code_server,do_add,4},
- {code_server,add_path,4},
- {code_server,handle_call,3},
- {code_server,loop,1},
- {code_server,system_continue,3}]) -> 0;
+ {code_server,try_archive_subdirs,3}|_]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',_},
[{erlang,apply,2},
{erlang,spawn_link,1},
@@ -905,140 +898,7 @@ uniq([H|T],A) ->
uniq(T,[H|A]).
-load_cached(suite) ->
- [];
-load_cached(doc) ->
- [];
-load_cached(Config) when is_list(Config) ->
- Priv = ?config(priv_dir, Config),
- WD = filename:dirname(code:which(?MODULE)),
- {ok,Node} =
- ?t:start_node(code_cache_node, peer, [{args,
- "-pa \"" ++ WD ++ "\""},
- {erl, [this]}]),
- CCTabCreated = fun(Tab) ->
- case ets:info(Tab, name) of
- code_cache -> true;
- _ -> false
- end
- end,
- Tabs = rpc:call(Node, ets, all, []),
- case rpc:call(Node, lists, any, [CCTabCreated,Tabs]) of
- true ->
- ?t:stop_node(Node),
- ?t:fail("Code cache should not be active!");
- false ->
- ok
- end,
- rpc:call(Node, code, del_path, [Priv]),
- rpc:call(Node, code, add_pathz, [Priv]),
-
- FullModName = Priv ++ "/code_cache_test",
- {ok,Dev} = file:open(FullModName ++ ".erl", [write]),
- io:format(Dev, "-module(code_cache_test). -export([a/0]). a() -> ok.~n", []),
- ok = file:close(Dev),
- {ok,code_cache_test} = compile:file(FullModName, [{outdir,Priv}]),
-
- F = fun load_loop/2,
- N = 1000,
- {T0,T1} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]),
- TNoCache = now_diff(T1, T0),
- rpc:call(Node, code, rehash, []),
- {T2,T3} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]),
- TCache = now_diff(T3, T2),
- AvgNoCache = TNoCache/N,
- AvgCache = TCache/N,
- io:format("Avg. load time (no_cache/cache): ~w/~w~n", [AvgNoCache,AvgCache]),
- ?t:stop_node(Node),
- if AvgNoCache =< AvgCache ->
- ?t:fail("Cache not working properly.");
- true ->
- ok
- end.
-
-load_loop(N, M) ->
- load_loop(N, M, now()).
-load_loop(0, _M, T0) ->
- {T0,now()};
-load_loop(N, M, T0) ->
- code:load_file(M),
- code:delete(M),
- code:purge(M),
- load_loop(N-1, M, T0).
-
-now_diff({A2, B2, C2}, {A1, B1, C1}) ->
- ((A2-A1)*1000000 + B2-B1)*1000000 + C2-C1.
-
-start_node_with_cache(suite) ->
- [];
-start_node_with_cache(doc) ->
- [];
-start_node_with_cache(Config) when is_list(Config) ->
- {ok,Node} =
- ?t:start_node(code_cache_node, peer, [{args,
- "-code_path_cache"},
- {erl, [this]}]),
- Tabs = rpc:call(Node, ets, all, []),
- io:format("Tabs: ~w~n", [Tabs]),
- CCTabCreated = fun(Tab) ->
- case rpc:call(Node, ets, info, [Tab,name]) of
- code_cache -> true;
- _ -> false
- end
- end,
- true = lists:any(CCTabCreated, Tabs),
- ?t:stop_node(Node),
- ok.
-
-add_and_rehash(suite) ->
- [];
-add_and_rehash(doc) ->
- [];
-add_and_rehash(Config) when is_list(Config) ->
- Priv = ?config(priv_dir, Config),
- WD = filename:dirname(code:which(?MODULE)),
- {ok,Node} =
- ?t:start_node(code_cache_node, peer, [{args,
- "-pa \"" ++ WD ++ "\""},
- {erl, [this]}]),
- CCTabCreated = fun(Tab) ->
- case ets:info(Tab, name) of
- code_cache -> true;
- _ -> false
- end
- end,
- Tabs0 = rpc:call(Node, ets, all, []),
- case rpc:call(Node, lists, any, [CCTabCreated,Tabs0]) of
- true ->
- ?t:stop_node(Node),
- ?t:fail("Code cache should not be active!");
- false ->
- ok
- end,
- ok = rpc:call(Node, code, rehash, []), % create cache
- Tabs1 = rpc:call(Node, ets, all, []),
- true = rpc:call(Node, lists, any, [CCTabCreated,Tabs1]), % cache table created
- ok = rpc:call(Node, code, rehash, []),
- OkDir = filename:join(Priv, ""),
- BadDir = filename:join(Priv, "guggemuffsussiputt"),
- CP = [OkDir | rpc:call(Node, code, get_path, [])],
- true = rpc:call(Node, code, set_path, [CP]),
- CP1 = [BadDir | CP],
- {error,_} = rpc:call(Node, code, set_path, [CP1]),
- true = rpc:call(Node, code, del_path, [OkDir]),
- true = rpc:call(Node, code, add_path, [OkDir]),
- true = rpc:call(Node, code, add_path, [OkDir]),
- {error,_} = rpc:call(Node, code, add_path, [BadDir]),
- ok = rpc:call(Node, code, rehash, []),
-
- ?t:stop_node(Node),
- ok.
-
-where_is_file_no_cache(suite) ->
- [];
-where_is_file_no_cache(doc) ->
- [];
-where_is_file_no_cache(Config) when is_list(Config) ->
+where_is_file(Config) when is_list(Config) ->
{T,KernelBeamFile} = timer:tc(code, where_is_file, ["kernel.beam"]),
io:format("Load time: ~w ms~n", [T]),
KernelEbinDir = filename:dirname(KernelBeamFile),
@@ -1047,35 +907,6 @@ where_is_file_no_cache(Config) when is_list(Config) ->
non_existing = code:where_is_file("kernel"), % no such file
ok.
-where_is_file_cached(suite) ->
- [];
-where_is_file_cached(doc) ->
- [];
-where_is_file_cached(Config) when is_list(Config) ->
- {ok,Node} =
- ?t:start_node(code_cache_node, peer, [{args,
- "-code_path_cache"},
- {erl, [this]}]),
- Tabs = rpc:call(Node, ets, all, []),
- io:format("Tabs: ~w~n", [Tabs]),
- CCTabCreated = fun(Tab) ->
- case rpc:call(Node, ets, info, [Tab,name]) of
- code_cache -> true;
- _ -> false
- end
- end,
- true = lists:any(CCTabCreated, Tabs),
- KernelBeamFile = rpc:call(Node, code, where_is_file, ["kernel.beam"]),
- {T,KernelBeamFile} = rpc:call(Node, timer, tc, [code,where_is_file,["kernel.beam"]]),
- io:format("Load time: ~w ms~n", [T]),
- KernelEbinDir = rpc:call(Node, filename, dirname, [KernelBeamFile]),
- AppFile = rpc:call(Node, filename, join, [KernelEbinDir,"kernel.app"]),
- AppFile = rpc:call(Node, code, where_is_file, ["kernel.app"]),
- non_existing = rpc:call(Node, code, where_is_file, ["kernel"]), % no such file
- ?t:stop_node(Node),
- ok.
-
-
purge_stacktrace(suite) ->
[];
purge_stacktrace(doc) ->
diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl
index 9988347581..21da958c11 100644
--- a/lib/kernel/test/disk_log_SUITE.erl
+++ b/lib/kernel/test/disk_log_SUITE.erl
@@ -29,7 +29,7 @@
-define(config(X,Y), foo).
-define(t,test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), ok).
-define(privdir(Conf), ?config(priv_dir, Conf)).
-define(datadir(Conf), ?config(data_dir, Conf)).
diff --git a/lib/kernel/test/erl_boot_server_SUITE.erl b/lib/kernel/test/erl_boot_server_SUITE.erl
index 954880e252..2450761ac9 100644
--- a/lib/kernel/test/erl_boot_server_SUITE.erl
+++ b/lib/kernel/test/erl_boot_server_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(erl_boot_server_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]).
diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl
index 2f73ab170a..3ac87384b4 100644
--- a/lib/kernel/test/erl_distribution_SUITE.erl
+++ b/lib/kernel/test/erl_distribution_SUITE.erl
@@ -20,7 +20,7 @@
-module(erl_distribution_SUITE).
%-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]).
diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl
index c107e92fae..e453cb2cdd 100644
--- a/lib/kernel/test/erl_distribution_wb_SUITE.erl
+++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(erl_distribution_wb_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/inet.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl
index 0803cf428f..bc14a2764d 100644
--- a/lib/kernel/test/erl_prim_loader_SUITE.erl
+++ b/lib/kernel/test/erl_prim_loader_SUITE.erl
@@ -20,7 +20,7 @@
-module(erl_prim_loader_SUITE).
-include_lib("kernel/include/file.hrl").
--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]).
@@ -133,14 +133,8 @@ inet_existing(doc) -> ["Start a node using the 'inet' loading method, ",
"from an already started boot server."];
inet_existing(Config) when is_list(Config) ->
Name = erl_prim_test_inet_existing,
- Host = host(),
- Cookie = atom_to_list(erlang:get_cookie()),
- IpStr = ip_str(Host),
- LFlag = get_loader_flag(os:type()),
- Args = LFlag ++ " -hosts " ++ IpStr ++
- " -setcookie " ++ Cookie,
- {ok, BootPid} = erl_boot_server:start_link([Host]),
- {ok, Node} = start_node(Name, Args),
+ BootPid = start_boot_server(),
+ Node = start_node_using_inet(Name),
{ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]),
stop_node(Node),
unlink(BootPid),
@@ -151,19 +145,11 @@ inet_coming_up(doc) -> ["Start a node using the 'inet' loading method, ",
"but start the boot server afterwards."];
inet_coming_up(Config) when is_list(Config) ->
Name = erl_prim_test_inet_coming_up,
- Cookie = atom_to_list(erlang:get_cookie()),
- Host = host(),
- IpStr = ip_str(Host),
- LFlag = get_loader_flag(os:type()),
- Args = LFlag ++
- " -hosts " ++ IpStr ++
- " -setcookie " ++ Cookie,
- {ok, Node} = start_node(Name, Args, [{wait, false}]),
+ Node = start_node_using_inet(Name, [{wait,false}]),
%% Wait a while, then start boot server, and wait for node to start.
test_server:sleep(test_server:seconds(6)),
- io:format("erl_boot_server:start_link([~p]).", [Host]),
- {ok, BootPid} = erl_boot_server:start_link([Host]),
+ BootPid = start_boot_server(),
wait_really_started(Node, 25),
%% Check loader argument, then cleanup.
@@ -191,24 +177,19 @@ inet_disconnects(Config) when is_list(Config) ->
true ->
{skip,"erl_boot_server is native"};
false ->
- ?line Name = erl_prim_test_inet_disconnects,
- ?line Host = host(),
- ?line Cookie = atom_to_list(erlang:get_cookie()),
- ?line IpStr = ip_str(Host),
- ?line LFlag = get_loader_flag(os:type()),
- ?line Args = LFlag ++ " -hosts " ++ IpStr ++
- " -setcookie " ++ Cookie,
+ Name = erl_prim_test_inet_disconnects,
- ?line {ok, BootPid} = erl_boot_server:start([Host]),
+ BootPid = start_boot_server(),
+ unlink(BootPid),
Self = self(),
%% This process shuts down the boot server during loading.
- ?line Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end),
- ?line receive
- {Stopper,ready} -> ok
- end,
+ Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end),
+ receive
+ {Stopper,ready} -> ok
+ end,
%% Let the loading begin...
- ?line {ok, Node} = start_node(Name, Args, [{wait, false}]),
+ Node = start_node_using_inet(Name, [{wait,false}]),
%% When the stopper is ready, the slave node should be
%% looking for a boot server again.
@@ -222,12 +203,12 @@ inet_disconnects(Config) when is_list(Config) ->
end,
%% Start new boot server to see that loading is continued.
- ?line {ok, BootPid2} = erl_boot_server:start_link([Host]),
- ?line wait_really_started(Node, 25),
- ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]),
- ?line stop_node(Node),
- ?line unlink(BootPid2),
- ?line exit(BootPid2, kill),
+ BootPid2 = start_boot_server(),
+ wait_really_started(Node, 25),
+ {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]),
+ stop_node(Node),
+ unlink(BootPid2),
+ exit(BootPid2, kill),
ok
end.
@@ -260,46 +241,38 @@ multiple_slaves(doc) ->
["Start nodes in parallell, all using the 'inet' loading method, ",
"verify that the boot server manages"];
multiple_slaves(Config) when is_list(Config) ->
- case os:type() of
- {ose,_} ->
- {comment, "OSE: multiple nodes not supported"};
- _ ->
- ?line Name = erl_prim_test_multiple_slaves,
- ?line Host = host(),
- ?line Cookie = atom_to_list(erlang:get_cookie()),
- ?line IpStr = ip_str(Host),
- ?line LFlag = get_loader_flag(os:type()),
- ?line Args = LFlag ++ " -hosts " ++ IpStr ++
- " -setcookie " ++ Cookie,
-
- NoOfNodes = 10, % no of slave nodes to be started
-
- NamesAndNodes =
- lists:map(fun(N) ->
- NameN = atom_to_list(Name) ++
- integer_to_list(N),
- NodeN = NameN ++ "@" ++ Host,
- {list_to_atom(NameN),list_to_atom(NodeN)}
- end, lists:seq(1, NoOfNodes)),
-
- ?line Nodes = start_multiple_nodes(NamesAndNodes, Args, []),
-
- %% "queue up" the nodes to wait for the boot server to respond
- %% (note: test_server supervises each node start by accept()
- %% on a socket, the timeout value for the accept has to be quite
- %% long for this test to work).
- ?line test_server:sleep(test_server:seconds(5)),
- %% start the code loading circus!
- ?line {ok,BootPid} = erl_boot_server:start_link([Host]),
- %% give the nodes a chance to boot up before attempting to stop them
- ?line test_server:sleep(test_server:seconds(10)),
-
- ?line wait_and_shutdown(lists:reverse(Nodes), 30),
-
- ?line unlink(BootPid),
- ?line exit(BootPid, kill),
- ok
- end.
+ ?line Name = erl_prim_test_multiple_slaves,
+ ?line Host = host(),
+ ?line IpStr = ip_str(Host),
+ Args = " -loader inet -hosts " ++ IpStr,
+
+ NoOfNodes = 10, % no of slave nodes to be started
+
+ NamesAndNodes =
+ lists:map(fun(N) ->
+ NameN = atom_to_list(Name) ++
+ integer_to_list(N),
+ NodeN = NameN ++ "@" ++ Host,
+ {list_to_atom(NameN),list_to_atom(NodeN)}
+ end, lists:seq(1, NoOfNodes)),
+
+ ?line Nodes = start_multiple_nodes(NamesAndNodes, Args, []),
+
+ %% "queue up" the nodes to wait for the boot server to respond
+ %% (note: test_server supervises each node start by accept()
+ %% on a socket, the timeout value for the accept has to be quite
+ %% long for this test to work).
+ ?line test_server:sleep(test_server:seconds(5)),
+ %% start the code loading circus!
+ BootPid = start_boot_server(),
+ %% give the nodes a chance to boot up before attempting to stop them
+ ?line test_server:sleep(test_server:seconds(10)),
+
+ ?line wait_and_shutdown(lists:reverse(Nodes), 30),
+
+ ?line unlink(BootPid),
+ ?line exit(BootPid, kill),
+ ok.
start_multiple_nodes([{Name,Node} | NNs], Args, Started) ->
?line {ok,Node} = start_node(Name, Args, [{wait, false}]),
@@ -367,20 +340,6 @@ file_requests(Config) when is_list(Config) ->
?line exit(BootPid, kill),
ok.
-complete_start_node(Name) ->
- ?line Host = host(),
- ?line Cookie = atom_to_list(erlang:get_cookie()),
- ?line IpStr = ip_str(Host),
- ?line LFlag = get_loader_flag(os:type()),
- ?line Args = LFlag ++ " -hosts " ++ IpStr ++
- " -setcookie " ++ Cookie,
-
- ?line {ok,BootPid} = erl_boot_server:start_link([Host]),
-
- ?line {ok,Node} = start_node(Name, Args),
- ?line wait_really_started(Node, 25),
- {ok, Node, BootPid}.
-
local_archive(suite) ->
[];
local_archive(doc) ->
@@ -397,7 +356,7 @@ local_archive(Config) when is_list(Config) ->
?line ok = test_archive(Node, Archive, KernelDir, BeamName),
%% Cleanup
- ?line ok = rpc:call(Node, erl_prim_loader, release_archives, []),
+ ok = rpc:call(Node, erl_prim_loader, purge_archive_cache, []),
?line ok = file:delete(Archive),
ok.
@@ -555,11 +514,41 @@ virtual_dir_in_archive(Config) when is_list(Config) ->
?line {ok, [EbinBase]} = erl_prim_loader:list_dir(AppDir),
%% Cleanup
- ?line ok = erl_prim_loader:release_archives(),
+ ok = erl_prim_loader:purge_archive_cache(),
?line ok = file:delete(Archive),
ok.
-%% Misc. functions
+%%%
+%%% Helper functions.
+%%%
+
+complete_start_node(Name) ->
+ BootPid = start_boot_server(),
+ Node = start_node_using_inet(Name),
+ wait_really_started(Node, 25),
+ {ok, Node, BootPid}.
+
+start_boot_server() ->
+ %% Many linux systems define:
+ %% 127.0.0.1 localhost
+ %% 127.0.1.1 somehostname
+ %% Therefore, to allow the tests to work on those kind of systems,
+ %% also include "localhost" in the list of allowed hosts.
+
+ Hosts = [host(),ip_str("localhost")],
+ {ok,BootPid} = erl_boot_server:start_link(Hosts),
+ BootPid.
+
+start_node_using_inet(Name) ->
+ start_node_using_inet(Name, []).
+
+start_node_using_inet(Name, Opts) ->
+ Host = host(),
+ IpStr = ip_str(Host),
+ Args = " -loader inet -hosts " ++ IpStr,
+ {ok,Node} = start_node(Name, Args, Opts),
+ Node.
+
ip_str({A, B, C, D}) ->
lists:concat([A, ".", B, ".", C, ".", D]);
@@ -585,9 +574,6 @@ host() ->
stop_node(Node) ->
test_server:stop_node(Node).
-get_loader_flag(_) ->
- " -loader inet ".
-
compile_app(TopDir, AppName) ->
AppDir = filename:join([TopDir, AppName]),
SrcDir = filename:join([AppDir, "src"]),
diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl
index f1988b68d9..fa0fc5b75c 100644
--- a/lib/kernel/test/error_logger_SUITE.erl
+++ b/lib/kernel/test/error_logger_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(error_logger_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%-----------------------------------------------------------------
%% We don't have to test the normal behaviour here, i.e. the tty
diff --git a/lib/kernel/test/error_logger_warn_SUITE.erl b/lib/kernel/test/error_logger_warn_SUITE.erl
index a3a3b2f8c6..40b3f6bd53 100644
--- a/lib/kernel/test/error_logger_warn_SUITE.erl
+++ b/lib/kernel/test/error_logger_warn_SUITE.erl
@@ -29,7 +29,7 @@
%% Internal exports.
-export([init/1,handle_event/2,handle_info/2,handle_call/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(EXPECT(Pattern),
(fun() ->
diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl
index 09d9a45197..e9401e26ef 100644
--- a/lib/kernel/test/file_SUITE.erl
+++ b/lib/kernel/test/file_SUITE.erl
@@ -106,7 +106,7 @@
%% System probe functions that might be handy to check from the shell
-export([disc_free/1, memsize/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
-define(THROW_ERROR(RES), throw({fail, ?LINE, RES})).
@@ -168,12 +168,7 @@ init_per_suite(Config) when is_list(Config) ->
ok ->
[{sasl,started}]
end,
- ok = case os:type() of
- {ose,_} ->
- ok;
- _ ->
- application:start(os_mon)
- end,
+ application:start(os_mon),
case os:type() of
{win32, _} ->
@@ -199,12 +194,7 @@ end_per_suite(Config) when is_list(Config) ->
ok
end,
- case os:type() of
- {ose,_} ->
- ok;
- _ ->
- application:stop(os_mon)
- end,
+ application:stop(os_mon),
case proplists:get_value(sasl, Config) of
started ->
application:stop(sasl);
@@ -889,10 +879,7 @@ open1(Config) when is_list(Config) ->
?line io:format(Fd1,Str,[]),
?line {ok,0} = ?FILE_MODULE:position(Fd1,bof),
?line Str = io:get_line(Fd1,''),
- ?line case io:get_line(Fd2,'') of
- Str -> Str;
- eof -> Str
- end,
+ ?line Str = io:get_line(Fd2,''),
?line ok = ?FILE_MODULE:close(Fd2),
?line {ok,0} = ?FILE_MODULE:position(Fd1,bof),
?line ok = ?FILE_MODULE:truncate(Fd1),
@@ -2368,9 +2355,6 @@ e_rename(Config) when is_list(Config) ->
%% At least Windows NT can
%% successfully move a file to
%% another drive.
- ok;
- {ose, _} ->
- %% disabled for now
ok
end,
[] = flush(),
diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl
index 32006d893e..e6f8761f95 100644
--- a/lib/kernel/test/file_name_SUITE.erl
+++ b/lib/kernel/test/file_name_SUITE.erl
@@ -19,7 +19,7 @@
%% %CopyrightEnd%
%%
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
%%
@@ -159,7 +159,7 @@ normalize(suite) ->
normalize(doc) ->
["Check that filename normalization works"];
normalize(Config) when is_list(Config) ->
- random:seed({1290,431421,830412}),
+ rand:seed(exsplus, {1290,431421,830412}),
try
?line UniMode = file:native_name_encoding() =/= latin1,
if
@@ -845,7 +845,7 @@ conv(L) ->
rand_comp_decomp(Max) ->
- N = random:uniform(Max),
+ N = rand:uniform(Max),
L = [ rand_decomp() || _ <- lists:seq(1,N) ],
LC = [ A || {A,_} <- L],
LD = lists:flatten([B || {_,B} <- L]),
@@ -855,7 +855,7 @@ rand_comp_decomp(Max) ->
rand_decomp() ->
BT = bigtup(),
SZ = tuple_size(BT),
- element(random:uniform(SZ),BT).
+ element(rand:uniform(SZ),BT).
bigtup() ->
{{192,[65,768]},
{200,[69,768]},
diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl
index 91a57d3290..99f8625ba9 100644
--- a/lib/kernel/test/gen_sctp_SUITE.erl
+++ b/lib/kernel/test/gen_sctp_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(gen_sctp_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/inet_sctp.hrl").
%%-compile(export_all).
diff --git a/lib/kernel/test/gen_tcp_echo_SUITE.erl b/lib/kernel/test/gen_tcp_echo_SUITE.erl
index 6dcb21758b..fe81cbac18 100644
--- a/lib/kernel/test/gen_tcp_echo_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_echo_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(gen_tcp_echo_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%-compile(export_all).
@@ -442,14 +442,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).
put_int32(X, big, List) ->
[ (X bsr 24) band 16#ff,
diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl
index 81c6dcd0fd..323796665b 100644
--- a/lib/kernel/test/gen_tcp_misc_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(gen_tcp_misc_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%-compile(export_all).
@@ -58,14 +58,6 @@
oct_acceptor/1,
otp_7731_server/1, zombie_server/2, do_iter_max_socks/2]).
-init_per_testcase(wrapping_oct, Config) when is_list(Config) ->
- Dog = case os:type() of
- {ose,_} ->
- test_server:timetrap(test_server:minutes(20));
- _Else ->
- test_server:timetrap(test_server:seconds(600))
- end,
- [{watchdog, Dog}|Config];
init_per_testcase(iter_max_socks, Config) when is_list(Config) ->
Dog = case os:type() of
{win32,_} ->
@@ -74,14 +66,6 @@ init_per_testcase(iter_max_socks, Config) when is_list(Config) ->
test_server:timetrap(test_server:seconds(240))
end,
[{watchdog, Dog}|Config];
-init_per_testcase(accept_system_limit, Config) when is_list(Config) ->
- case os:type() of
- {ose,_} ->
- {skip,"Skip in OSE"};
- _ ->
- Dog = test_server:timetrap(test_server:seconds(240)),
- [{watchdog,Dog}|Config]
- end;
init_per_testcase(wrapping_oct, Config) when is_list(Config) ->
Dog = test_server:timetrap(test_server:seconds(600)),
[{watchdog, Dog}|Config];
diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl
index 8d8c953303..2efbf26e1c 100644
--- a/lib/kernel/test/gen_udp_SUITE.erl
+++ b/lib/kernel/test/gen_udp_SUITE.erl
@@ -22,7 +22,7 @@
% because udp is not deterministic.
%
-module(gen_udp_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl
index 73ee86eba4..0046fdafa4 100644
--- a/lib/kernel/test/global_SUITE.erl
+++ b/lib/kernel/test/global_SUITE.erl
@@ -51,7 +51,7 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(NODES, [node()|nodes()]).
@@ -1349,7 +1349,7 @@ stress_partition(Config) when is_list(Config) ->
%% Use this one to test alot of connection tests
-%% erl -sname ts -rsh ctrsh -pa /clearcase/otp/internal_tools/test_server/ebin/ -ring_line 10000 -s test_server run_test global_SUITE
+%% erl -sname ts -ring_line 10000 -s test_server run_test global_SUITE
ring_line(suite) -> [];
ring_line(doc) -> [""];
@@ -2931,7 +2931,7 @@ sync_until(LogFile) ->
timer:sleep(Time).
shuffle(L) ->
- [E || {_, E} <- lists:keysort(1, [{random:uniform(), E} || E <- L])].
+ [E || {_, E} <- lists:keysort(1, [{rand:uniform(), E} || E <- L])].
sync_0(suite) -> [];
sync_0(doc) ->
diff --git a/lib/kernel/test/global_group_SUITE.erl b/lib/kernel/test/global_group_SUITE.erl
index 0a994c3bf0..e7d321418c 100644
--- a/lib/kernel/test/global_group_SUITE.erl
+++ b/lib/kernel/test/global_group_SUITE.erl
@@ -30,7 +30,7 @@
%-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(NODES, [node()|nodes()]).
diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl
index 39cd29cea0..eb6cb06622 100644
--- a/lib/kernel/test/heart_SUITE.erl
+++ b/lib/kernel/test/heart_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(heart_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, start/1, restart/1,
diff --git a/lib/kernel/test/ignore_cores.erl b/lib/kernel/test/ignore_cores.erl
index db61c4003b..6a37b48189 100644
--- a/lib/kernel/test/ignore_cores.erl
+++ b/lib/kernel/test/ignore_cores.erl
@@ -28,7 +28,7 @@
-module(ignore_cores).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]).
diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl
index 5ba06bb032..0a36bc9673 100644
--- a/lib/kernel/test/inet_SUITE.erl
+++ b/lib/kernel/test/inet_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(inet_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/inet.hrl").
-include_lib("kernel/src/inet_dns.hrl").
@@ -868,7 +868,6 @@ gethostnative_control_2(Seq, Interval, Delay, Cnt, N, Hosts) ->
?line Lookupers =
[spawn_link(
fun () ->
- random:seed(),
lookup_loop(Hosts, Delay, Tag, Parent, Cnt, Hosts)
end)
|| _ <- lists:seq(1, N)],
@@ -929,7 +928,7 @@ lookup_loop([H|Hs], Delay, Tag, Parent, Cnt, Hosts) ->
Parent ! {Tag,Error}
end,
receive
- after random:uniform(Delay) ->
+ after rand:uniform(Delay) ->
lookup_loop(Hs, Delay, Tag, Parent, Cnt-1, Hosts)
end.
diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl
index ace4ccb8bd..ea06061c74 100644
--- a/lib/kernel/test/inet_res_SUITE.erl
+++ b/lib/kernel/test/inet_res_SUITE.erl
@@ -20,7 +20,6 @@
-module(inet_res_SUITE).
-include_lib("common_test/include/ct.hrl").
--include("test_server_line.hrl").
-include_lib("kernel/include/inet.hrl").
-include_lib("kernel/src/inet_dns.hrl").
@@ -120,7 +119,7 @@ ns_init(ZoneDir, PrivDir, DataDir) ->
{unix,_} ->
PortNum = case {os:type(),os:version()} of
{{unix,solaris},{M,V,_}} when M =< 5, V < 10 ->
- 11895 + random:uniform(100);
+ 11895 + rand:uniform(100);
_ ->
{ok,S} = gen_udp:open(0, [{reuseaddr,true}]),
{ok,PNum} = inet:port(S),
diff --git a/lib/kernel/test/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl
index cb522c8abe..a6981854c8 100644
--- a/lib/kernel/test/inet_sockopt_SUITE.erl
+++ b/lib/kernel/test/inet_sockopt_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(inet_sockopt_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(C_GET_IPPROTO_TCP,1).
diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl
index 54ab5aa566..cb531f7b57 100644
--- a/lib/kernel/test/init_SUITE.erl
+++ b/lib/kernel/test/init_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(init_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]).
@@ -307,8 +307,8 @@ create_boot(Config) ->
is_real_system(KernelVsn, StdlibVsn) ->
LibDir = code:lib_dir(),
- filelib:is_dir(filename:join(LibDir, "kernel"++KernelVsn)) andalso
- filelib:is_dir(filename:join(LibDir, "stdlib"++StdlibVsn)).
+ filelib:is_dir(filename:join(LibDir, "kernel-"++KernelVsn)) andalso
+ filelib:is_dir(filename:join(LibDir, "stdlib-"++StdlibVsn)).
%% ------------------------------------------------
%% Slave executes erlang:halt() on master nodedown.
@@ -401,6 +401,7 @@ restart(Config) when is_list(Config) ->
%% Ok, the node is up, now the real test test begins.
?line erlang:monitor_node(Node, true),
?line InitPid = rpc:call(Node, erlang, whereis, [init]),
+ ?line PurgerPid = rpc:call(Node, erlang, whereis, [erts_code_purger]),
?line Procs = rpc:call(Node, erlang, processes, []),
?line MaxPid = lists:last(Procs),
?line ok = rpc:call(Node, init, restart, []),
@@ -418,8 +419,13 @@ restart(Config) when is_list(Config) ->
InitP = pid_to_list(InitPid),
?line InitP = pid_to_list(InitPid1),
+ %% and same purger process!
+ ?line PurgerPid1 = rpc:call(Node, erlang, whereis, [erts_code_purger]),
+ PurgerP = pid_to_list(PurgerPid),
+ ?line PurgerP = pid_to_list(PurgerPid1),
+
?line NewProcs0 = rpc:call(Node, erlang, processes, []),
- NewProcs = lists:delete(InitPid1, NewProcs0),
+ NewProcs = NewProcs0 -- [InitPid1, PurgerPid1],
?line case check_processes(NewProcs, MaxPid) of
true ->
ok;
diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl
index 8adae1f606..d7fa52b721 100644
--- a/lib/kernel/test/interactive_shell_SUITE.erl
+++ b/lib/kernel/test/interactive_shell_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(interactive_shell_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,
get_columns_and_rows/1, exit_initial/1, job_control_local/1,
diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl
index 8ae2e4b23b..64c7ce6136 100644
--- a/lib/kernel/test/kernel_SUITE.erl
+++ b/lib/kernel/test/kernel_SUITE.erl
@@ -21,7 +21,7 @@
%%% Kernel application test suite.
%%%-----------------------------------------------------------------
-module(kernel_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% Test server specific exports
diff --git a/lib/kernel/test/kernel_config_SUITE.erl b/lib/kernel/test/kernel_config_SUITE.erl
index 4be44015c9..1486619b1c 100644
--- a/lib/kernel/test/kernel_config_SUITE.erl
+++ b/lib/kernel/test/kernel_config_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(kernel_config_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_group/2,end_per_group/2, sync/1]).
diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl
index 29d8d10262..29fc3a2ea5 100644
--- a/lib/kernel/test/os_SUITE.erl
+++ b/lib/kernel/test/os_SUITE.erl
@@ -20,17 +20,20 @@
-module(os_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_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2]).
-export([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1,
- find_executable/1, unix_comment_in_command/1, deep_list_command/1, evil/1]).
+ find_executable/1, unix_comment_in_command/1, deep_list_command/1,
+ large_output_command/1, perf_counter_api/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command,
- find_executable, unix_comment_in_command, deep_list_command, evil].
+ find_executable, unix_comment_in_command, deep_list_command,
+ large_output_command, perf_counter_api].
groups() ->
[].
@@ -47,6 +50,11 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+init_per_testcase(_TC,Config) ->
+ Config.
+
+end_per_testcase(_,_Config) ->
+ ok.
space_in_cwd(doc) ->
"Test that executing a command in a current working directory "
@@ -267,50 +275,48 @@ deep_list_command(Config) when is_list(Config) ->
%% FYI: [$e, $c, "ho"] =:= io_lib:format("ec~s", ["ho"])
ok.
-
--define(EVIL_PROCS, 100).
--define(EVIL_LOOPS, 100).
--define(PORT_CREATOR, os_cmd_port_creator).
-evil(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:minutes(5)),
- Parent = self(),
- Ps = lists:map(fun (N) ->
- spawn_link(fun () ->
- evil_loop(Parent, ?EVIL_LOOPS,N)
- end)
- end, lists:seq(1, ?EVIL_PROCS)),
- Devil = spawn_link(fun () -> devil(hd(Ps), hd(lists:reverse(Ps))) end),
- lists:foreach(fun (P) -> receive {P, done} -> ok end end, Ps),
- unlink(Devil),
- exit(Devil, kill),
- test_server:timetrap_cancel(Dog),
- ok.
-
-devil(P1, P2) ->
- erlang:display({?PORT_CREATOR, whereis(?PORT_CREATOR)}),
- (catch ?PORT_CREATOR ! lists:seq(1,1000000)),
- (catch ?PORT_CREATOR ! lists:seq(1,666)),
- (catch ?PORT_CREATOR ! grrrrrrrrrrrrrrrr),
- (catch ?PORT_CREATOR ! {'EXIT', P1, buhuuu}),
- (catch ?PORT_CREATOR ! {'EXIT', hd(erlang:ports()), buhuuu}),
- (catch ?PORT_CREATOR ! {'EXIT', P2, arggggggg}),
- receive after 500 -> ok end,
- (catch exit(whereis(?PORT_CREATOR), kill)),
- (catch ?PORT_CREATOR ! ">8|"),
- receive after 500 -> ok end,
- (catch exit(whereis(?PORT_CREATOR), diiiiiiiiiiiiiiiiiiiie)),
- receive after 100 -> ok end,
- devil(P1, P2).
-
-evil_loop(Parent, Loops, N) ->
- Res = integer_to_list(N),
- evil_loop(Parent, Loops, Res, "echo " ++ Res).
-
-evil_loop(Parent, 0, _Res, _Cmd) ->
- Parent ! {self(), done};
-evil_loop(Parent, Loops, Res, Cmd) ->
- comp(Res, os:cmd(Cmd)),
- evil_loop(Parent, Loops-1, Res, Cmd).
+large_output_command(doc) ->
+ "Test to take sure that the correct data is"
+ "received when doing large commands";
+large_output_command(suite) -> [];
+large_output_command(Config) when is_list(Config) ->
+ %% Maximum allowed on windows is 8192, so we test well below that
+ AAA = lists:duplicate(7000, $a),
+ comp(AAA,os:cmd("echo " ++ AAA)).
+
+%% Test that the os:perf_counter api works as expected
+perf_counter_api(_Config) ->
+
+ true = is_integer(os:perf_counter()),
+ true = os:perf_counter() > 0,
+
+ T1 = os:perf_counter(),
+ timer:sleep(100),
+ T2 = os:perf_counter(),
+ TsDiff = erlang:convert_time_unit(T2 - T1, perf_counter, nano_seconds),
+ ct:pal("T1: ~p~n"
+ "T2: ~p~n"
+ "TsDiff: ~p~n",
+ [T1,T2,TsDiff]),
+
+ %% We allow a 15% diff
+ true = TsDiff < 115000000,
+ true = TsDiff > 85000000,
+
+ T1Ms = os:perf_counter(1000),
+ timer:sleep(100),
+ T2Ms = os:perf_counter(1000),
+ MsDiff = T2Ms - T1Ms,
+ ct:pal("T1Ms: ~p~n"
+ "T2Ms: ~p~n"
+ "MsDiff: ~p~n",
+ [T1Ms,T2Ms,MsDiff]),
+
+ %% We allow a 15% diff
+ true = MsDiff < 115,
+ true = MsDiff > 85.
+
+%% Util functions
comp(Expected, Got) ->
case strip_nl(Got) of
diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl
index 6de4ff9f77..80025d2fd9 100644
--- a/lib/kernel/test/pdict_SUITE.erl
+++ b/lib/kernel/test/pdict_SUITE.erl
@@ -21,7 +21,7 @@
%% NB: The ?line macro cannot be used when testing the dictionary.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(M(A,B),m(A,B,?MODULE,?LINE)).
-ifdef(DEBUG).
@@ -32,6 +32,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
+ mixed/1,
simple/1, complicated/1, heavy/1, simple_all_keys/1, info/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
-export([other_process/2]).
@@ -47,7 +48,8 @@ end_per_testcase(_Case, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [simple, complicated, heavy, simple_all_keys, info].
+ [simple, complicated, heavy, simple_all_keys, info,
+ mixed].
groups() ->
[].
@@ -369,3 +371,60 @@ match_keys(All) ->
Ks = lists:sort([K||{K,_}<-All]),
Ks = lists:sort(erlang:get_keys()),
ok.
+
+
+%% Do random mixed put/erase to test grow/shrink
+%% Written for a temporary bug in gc during shrink
+mixed(_Config) ->
+ Rand0 = rand:seed_s(exsplus),
+ io:format("Random seed = ~p\n\n", [rand:export_seed_s(Rand0)]),
+
+ erts_debug:set_internal_state(available_internal_state, true),
+ try
+ C = do_mixed([10,0,100,50,1000,500,600,100,150,1,11,2,30,0],
+ 0,
+ array:new(),
+ 1,
+ Rand0),
+ io:format("\nDid total of ~p operations\n", [C])
+ after
+ erts_debug:set_internal_state(available_internal_state, false)
+ end.
+
+do_mixed([], _, _, C, _) ->
+ C;
+do_mixed([GoalN | Tail], GoalN, Array, C, Rand0) ->
+ io:format("Reached goal of ~p keys in dict after ~p mixed ops\n",[GoalN, C]),
+ GoalN = array:size(Array),
+ do_mixed(Tail, GoalN, Array, C, Rand0);
+do_mixed([GoalN | _]=Goals, CurrN, Array0, C, Rand0) ->
+ CurrN = array:size(Array0),
+ GrowPercent = case GoalN > CurrN of
+ true when CurrN == 0 -> 100;
+ true -> 75;
+ false -> 25
+ end,
+ {R, Rand1} = rand:uniform_s(100, Rand0),
+ case R of
+ _ when R =< GrowPercent -> %%%%%%%%%%%%% GROW
+ {Key, Rand2} = rand:uniform_s(10000, Rand1),
+ case put(Key, {Key,C}) of
+ undefined ->
+ Array1 = array:set(CurrN, Key, Array0),
+ do_mixed(Goals, CurrN+1, Array1, C+1, Rand2);
+ _ ->
+ do_mixed(Goals, CurrN, Array0, C+1, Rand2)
+ end;
+
+ _ -> %%%%%%%%%% SHRINK
+ {Kix, Rand2} = rand:uniform_s(CurrN, Rand1),
+ Key = array:get(Kix-1, Array0),
+
+ %% provoke GC during shrink
+ erts_debug:set_internal_state(fill_heap, true),
+
+ {Key, _} = erase(Key),
+ Array1 = array:set(Kix-1, array:get(CurrN-1, Array0), Array0),
+ Array2 = array:resize(CurrN-1, Array1),
+ do_mixed(Goals, CurrN-1, Array2, C+1, Rand2)
+ end.
diff --git a/lib/kernel/test/pg2_SUITE.erl b/lib/kernel/test/pg2_SUITE.erl
index 832d2d1c27..6e4f5ee682 100644
--- a/lib/kernel/test/pg2_SUITE.erl
+++ b/lib/kernel/test/pg2_SUITE.erl
@@ -21,7 +21,7 @@
%%-----------------------------------------------------------------
-module(pg2_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(datadir, ?config(data_dir, Config)).
-define(privdir, ?config(priv_dir, Config)).
diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl
index 3e6d8492f7..1265180354 100644
--- a/lib/kernel/test/prim_file_SUITE.erl
+++ b/lib/kernel/test/prim_file_SUITE.erl
@@ -62,7 +62,7 @@
-export([allocate/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
-define(PRIM_FILE, prim_file).
@@ -455,10 +455,7 @@ open1(Config) when is_list(Config) ->
?line ?PRIM_FILE:write(Fd1,Str),
?line {ok,0} = ?PRIM_FILE:position(Fd1,bof),
?line {ok, Str} = ?PRIM_FILE:read(Fd1,Length),
- ?line case ?PRIM_FILE:read(Fd2,Length) of
- {ok,Str} -> Str;
- eof -> Str
- end,
+ ?line {ok, Str} = ?PRIM_FILE:read(Fd2,Length),
?line ok = ?PRIM_FILE:close(Fd2),
?line {ok,0} = ?PRIM_FILE:position(Fd1,bof),
?line ok = ?PRIM_FILE:truncate(Fd1),
@@ -1629,7 +1626,7 @@ e_rename(Config) when is_list(Config) ->
%% successfully move a file to
%% another drive.
ok;
- {unix, _ } ->
+ _ ->
OtherFs = "/tmp",
?line NameOnOtherFs =
filename:join(OtherFs,
@@ -1653,10 +1650,7 @@ e_rename(Config) when is_list(Config) ->
Else ->
Else
end,
- Com;
- {ose, _} ->
- %% disabled for now
- ok
+ Com
end,
?line test_server:timetrap_cancel(Dog),
Comment.
diff --git a/lib/kernel/test/ram_file_SUITE.erl b/lib/kernel/test/ram_file_SUITE.erl
index 933dc88d21..fdb61a3619 100644
--- a/lib/kernel/test/ram_file_SUITE.erl
+++ b/lib/kernel/test/ram_file_SUITE.erl
@@ -28,7 +28,7 @@
truncate/1, sync/1, get_set_file/1, compress/1, uuencode/1,
large_file_errors/1, large_file_light/1, large_file_heavy/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
-define(FILE_MODULE, file). % Name of module to test
diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl
index ed30c2dffa..42c522b1bd 100644
--- a/lib/kernel/test/rpc_SUITE.erl
+++ b/lib/kernel/test/rpc_SUITE.erl
@@ -28,7 +28,7 @@
-export([suicide/2, suicide/3, f/0, f2/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl
index 6a63f7bc9c..fb6f62d2e5 100644
--- a/lib/kernel/test/seq_trace_SUITE.erl
+++ b/lib/kernel/test/seq_trace_SUITE.erl
@@ -33,7 +33,7 @@
do_match_set_seq_token/1, do_gc_seq_token/1, countdown_start/2]).
%-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(TIMESTAMP_MODES, [no_timestamp,
timestamp,
diff --git a/lib/kernel/test/wrap_log_reader_SUITE.erl b/lib/kernel/test/wrap_log_reader_SUITE.erl
index 9a93b9037f..27ff98dc17 100644
--- a/lib/kernel/test/wrap_log_reader_SUITE.erl
+++ b/lib/kernel/test/wrap_log_reader_SUITE.erl
@@ -29,7 +29,7 @@
-define(config(X,Y), foo).
-define(t,test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), ok).
-define(privdir(Conf), ?config(priv_dir, Conf)).
-endif.
diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl
index 6aaa024a82..d9d4c138d5 100644
--- a/lib/kernel/test/zlib_SUITE.erl
+++ b/lib/kernel/test/zlib_SUITE.erl
@@ -20,7 +20,7 @@
-module(zlib_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile(export_all).
@@ -912,7 +912,7 @@ smp(Config) ->
FnAList = lists:map(fun(F) -> {F,?MODULE:F({get_arg,Config})}
end, Funcs),
- Pids = [spawn_link(?MODULE, worker, [random:uniform(9999),
+ Pids = [spawn_link(?MODULE, worker, [rand:uniform(9999),
list_to_tuple(FnAList),
self()])
|| _ <- lists:seq(1,NumOfProcs)],
@@ -925,7 +925,7 @@ smp(Config) ->
worker(Seed, FnATpl, Parent) ->
io:format("smp worker ~p, seed=~p~n",[self(),Seed]),
- random:seed(Seed,Seed,Seed),
+ rand:seed(exsplus, {Seed,Seed,Seed}),
worker_loop(100, FnATpl),
Parent ! self().
@@ -933,7 +933,7 @@ worker_loop(0, _FnATpl) ->
large_deflate_do(), % the time consuming one as finale
ok;
worker_loop(N, FnATpl) ->
- {F,A} = element(random:uniform(size(FnATpl)),FnATpl),
+ {F,A} = element(rand:uniform(tuple_size(FnATpl)), FnATpl),
?MODULE:F(A),
worker_loop(N-1, FnATpl).
diff --git a/lib/megaco/test/Makefile b/lib/megaco/test/Makefile
index 06ecc06d20..d621b0f16d 100644
--- a/lib/megaco/test/Makefile
+++ b/lib/megaco/test/Makefile
@@ -100,10 +100,7 @@ ifeq ($(USE_MEGACO_HIPE),true)
ERL_COMPILE_FLAGS += +native -Dmegaco_hipe_special=true
endif
-ERL_COMPILE_FLAGS += \
- $(MEGACO_ERL_COMPILE_FLAGS) \
- -pa $(ERL_TOP)/lib/test_server/ebin \
- -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS += $(MEGACO_ERL_COMPILE_FLAGS)
ERL_PATH = -pa ../../megaco/examples/simple \
-pa ../../megaco/ebin \
diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl
index 0f1354f43e..a5eded4f0f 100644
--- a/lib/mnesia/src/mnesia_lib.erl
+++ b/lib/mnesia/src/mnesia_lib.erl
@@ -922,20 +922,7 @@ random_time(Retries, _Counter0) ->
UpperLimit = 500,
Dup = Retries * Retries,
MaxIntv = trunc(UpperLimit * (1-(50/((Dup)+50)))),
-
- case get(random_seed) of
- undefined ->
- _ = random:seed(erlang:unique_integer(),
- erlang:monotonic_time(),
- erlang:unique_integer()),
- Time = Dup + random:uniform(MaxIntv),
- %% dbg_out("---random_test rs ~w max ~w val ~w---~n", [Retries, MaxIntv, Time]),
- Time;
- _ ->
- Time = Dup + random:uniform(MaxIntv),
- %% dbg_out("---random_test rs ~w max ~w val ~w---~n", [Retries, MaxIntv, Time]),
- Time
- end.
+ Dup + rand:uniform(MaxIntv).
report_system_event(Event0) ->
Event = {mnesia_system_event, Event0},
diff --git a/lib/mnesia/test/mnesia_consistency_test.erl b/lib/mnesia/test/mnesia_consistency_test.erl
index 087aef86c9..279e7bc1ec 100644
--- a/lib/mnesia/test/mnesia_consistency_test.erl
+++ b/lib/mnesia/test/mnesia_consistency_test.erl
@@ -696,7 +696,7 @@ consistency_after_restore(ReplicaType, Op, Config) ->
?verify_mnesia(Nodes, []).
change_tab(Father, Tab, Test) ->
- Key = random:uniform(20),
+ Key = rand:uniform(20),
Update = fun() ->
case mnesia:read({Tab, Key}) of
[{Tab, Key, 1}] ->
diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl
index 8d5c8a9037..d37623d1cc 100644
--- a/lib/observer/src/observer_alloc_wx.erl
+++ b/lib/observer/src/observer_alloc_wx.erl
@@ -30,19 +30,23 @@
-record(state,
{
- offset = 0.0,
+ time = #ti{},
active = false,
parent,
- windows,
- data = {0, queue:new()},
+ wins,
+ mem,
+ samples,
panel,
paint,
appmon,
async
}).
--define(ALLOC_W, 1).
--define(UTIL_W, 2).
+-define(ID_REFRESH_INTERVAL, 102).
+
+-import(observer_perf_wx,
+ [make_win/4, setup_graph_drawing/1, refresh_panel/4, interval_dialog/2,
+ add_data/5, precalc/4]).
start_link(Notebook, Parent) ->
wx_object:start_link(?MODULE, [Notebook, Parent], []).
@@ -51,34 +55,44 @@ init([Notebook, Parent]) ->
try
Panel = wxPanel:new(Notebook),
Main = wxBoxSizer:new(?wxVERTICAL),
- Style = ?wxFULL_REPAINT_ON_RESIZE bor ?wxCLIP_CHILDREN,
- Carrier = wxPanel:new(Panel, [{winid, ?ALLOC_W}, {style,Style}]),
- Utilz = wxPanel:new(Panel, [{winid, ?UTIL_W}, {style,Style}]),
BorderFlags = ?wxLEFT bor ?wxRIGHT,
- wxSizer:add(Main, Carrier, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP},
- {proportion, 1}, {border, 5}]),
-
- wxSizer:add(Main, Utilz, [{flag, ?wxEXPAND bor BorderFlags},
- {proportion, 1}, {border, 5}]),
+ Carrier = make_win(alloc, Panel, Main, BorderFlags bor ?wxTOP),
+ Utilz = make_win(utilz, Panel, Main, BorderFlags),
MemWin = {MemPanel,_} = create_mem_info(Panel),
wxSizer:add(Main, MemPanel, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM},
{proportion, 1}, {border, 5}]),
wxWindow:setSizer(Panel, Main),
-
- PaintInfo = observer_perf_wx:setup_graph_drawing([Carrier, Utilz]),
- {Panel, #state{parent=Parent,
- panel =Panel,
- windows = {Carrier, Utilz, MemWin},
- paint=PaintInfo}
+ Windows = [Carrier, Utilz],
+ PaintInfo = setup_graph_drawing(Windows),
+ {Panel, #state{parent= Parent,
+ panel = Panel,
+ wins = Windows,
+ mem = MemWin,
+ paint = PaintInfo,
+ time = setup_time()
+ }
}
catch _:Err ->
io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]),
{stop, Err}
end.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+setup_time() ->
+ Freq = 1,
+ #ti{fetch=Freq, disp=?DISP_FREQ/Freq}.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_selected}},
+ #state{panel=Panel, appmon=Old, wins=Wins0, time=#ti{fetch=F0} = Ti0} = State) ->
+ case interval_dialog(Panel, Ti0) of
+ Ti0 -> {noreply, State};
+ #ti{fetch=F0} = Ti -> %% Same fetch interval force refresh
+ Wins = [W#win{max=undefined} || W <- Wins0],
+ {noreply, precalc(State#state{time=Ti, wins=Wins})};
+ Ti -> %% Changed fetch interval, drop all data
+ {noreply, restart_fetcher(Old, State#state{time=Ti})}
+ end;
handle_event(#wx{event=#wxCommand{type=command_menu_selected}},
State = #state{}) ->
{noreply, State};
@@ -88,13 +102,11 @@ handle_event(Event, _State) ->
%%%%%%%%%%
handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_,
- #state{active=Active, offset=Offset, paint=Paint,
- windows=Windows, data=Data}) ->
+ #state{active=Active, time=Ti, paint=Paint,
+ wins = Windows}) ->
%% Sigh workaround bug on MacOSX (Id in paint event is always 0)
- Id = if Panel =:= element(?ALLOC_W, Windows) -> alloc;
- Panel =:= element(?UTIL_W, Windows) -> utilz
- end,
- observer_perf_wx:refresh_panel(Panel, Id, Offset, Data, Active, Paint),
+ Win = lists:keyfind(Panel, #win.panel, Windows),
+ refresh_panel(Active, Win, Ti, Paint),
ok.
%%%%%%%%%%
handle_call(Event, From, _State) ->
@@ -107,24 +119,37 @@ handle_cast(Event, _State) ->
handle_info({Key, {promise_reply, {badrpc, _}}}, #state{async=Key} = State) ->
{noreply, State#state{active=false, appmon=undefined}};
-handle_info({Key, {promise_reply, SysInfo}}, #state{async=Key, data=Data} = State) ->
+handle_info({Key, {promise_reply, SysInfo}},
+ #state{async=Key, panel=Panel, samples=Data, active=Active, wins=Wins0,
+ time=#ti{tick=Tick, disp=Disp0}=Ti} = S0) ->
+ Disp = trunc(Disp0),
+ Next = max(Tick - Disp, 0),
+ erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}),
Info = alloc_info(SysInfo),
- update_alloc(State, Info),
- {noreply, State#state{offset=0.0, data = add_data(Info, Data), async=undefined}};
+ {Wins, Samples} = add_data(Info, Data, Wins0, Ti, Active),
+ S1 = S0#state{time=Ti#ti{tick=Next}, wins=Wins, samples=Samples, async=undefined},
+ if Active ->
+ update_alloc(S0, Info),
+ State = precalc(S1),
+ catch wxWindow:refresh(Panel),
+ {noreply, State};
+ true ->
+ {noreply, S1}
+ end;
-handle_info({refresh, Seq, Freq, Node}, #state{panel=Panel, appmon=Node, async=Key} = State) ->
- wxWindow:refresh(Panel),
+handle_info({refresh, Seq},
+ State = #state{panel=Panel, appmon=Node, time=#ti{tick=Seq, disp=DispF}=Ti})
+ when (Seq+1) < (DispF*1.5) ->
Next = Seq+1,
- if
- Next > Freq, Key =:= undefined ->
- erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq, Node}),
+ State#state.active andalso (catch wxWindow:refresh(Panel)),
+ erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}),
+ if Seq =:= (trunc(DispF)-1) ->
Req = rpc:async_call(Node, observer_backend, sys_info, []),
- {noreply, State#state{offset=Seq/Freq, async=Req}};
+ {noreply, State#state{time=Ti#ti{tick=Next}, async=Req}};
true ->
- erlang:send_after(trunc(1000 / Freq), self(), {refresh, Next, Freq, Node}),
- {noreply, State#state{offset=Seq/Freq}}
+ {noreply, State#state{time=Ti#ti{tick=Next}}}
end;
-handle_info({refresh, _Seq, _Freq, _Node}, State) ->
+handle_info({refresh, _S}, #state{}=State) ->
{noreply, State};
handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Old}) ->
@@ -132,15 +157,9 @@ handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Ol
try
Node = Old,
wxWindow:refresh(Panel),
- {noreply, State#state{active=true}}
+ {noreply, precalc(State#state{active=true})}
catch _:_ ->
- SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []),
- Info = alloc_info(SysInfo),
- Freq = 6,
- erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq, Node}),
- wxWindow:refresh(Panel),
- {noreply, State#state{active=true, appmon=Node, offset=0.0,
- data = add_data(Info, {0, queue:new()})}}
+ {noreply, restart_fetcher(Node, State)}
end;
handle_info(not_active, State = #state{appmon=_Pid}) ->
@@ -160,12 +179,21 @@ code_change(_, _, State) ->
%%%%%%%%%%
-add_data(Stats, {N, Q}) when N > 60 ->
- {N, queue:drop(queue:in(Stats, Q))};
-add_data(Stats, {N, Q}) ->
- {N+1, queue:in(Stats, Q)}.
+restart_fetcher(Node, #state{panel=Panel, wins=Wins0, time=Ti} = State) ->
+ SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []),
+ Info = alloc_info(SysInfo),
+ {Wins, Samples} = add_data(Info, {0, queue:new()}, Wins0, Ti, true),
+ erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}),
+ wxWindow:refresh(Panel),
+ precalc(State#state{active=true, appmon=Node, time=Ti#ti{tick=0},
+ wins=Wins, samples=Samples}).
+
+precalc(#state{samples=Data0, paint=Paint, time=Ti, wins=Wins0}=State) ->
+ Wins = [precalc(Ti, Data0, Paint, Win) || Win <- Wins0],
+ State#state{wins=Wins}.
+
-update_alloc(#state{windows={_, _, {_, Grid}}}, Fields) ->
+update_alloc(#state{mem={_, Grid}}, Fields) ->
Max = wxListCtrl:getItemCount(Grid),
Update = fun({Name, BS, CS}, Row) ->
(Row >= Max) andalso wxListCtrl:insertItem(Grid, Row, ""),
@@ -174,7 +202,7 @@ update_alloc(#state{windows={_, _, {_, Grid}}}, Fields) ->
wxListCtrl:setItem(Grid, Row, 2, observer_lib:to_str(CS div 1024)),
Row + 1
end,
- lists:foldl(Update, 0, Fields),
+ wx:foldl(Update, 0, Fields),
Fields.
alloc_info(SysInfo) ->
@@ -247,11 +275,7 @@ create_mem_info(Parent) ->
create_menus(Parent, _) ->
- MenuEntries =
- [{"File",
- [
- ]}
- ],
- observer_wx:create_menus(Parent, MenuEntries).
+ View = {"View", [#create_menu{id = ?ID_REFRESH_INTERVAL, text = "Graph Settings"}]},
+ observer_wx:create_menus(Parent, [{"File", []}, View]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl
index a2b7c21993..40e117357c 100644
--- a/lib/observer/src/observer_app_wx.erl
+++ b/lib/observer/src/observer_app_wx.erl
@@ -29,7 +29,7 @@
-include("observer_defs.hrl").
%% Import drawing wrappers
--import(observer_perf_wx, [haveGC/0,
+-import(observer_perf_wx, [haveGC/0, make_gc/2, destroy_gc/1,
setPen/2, setFont/3, setBrush/2,
strokeLine/5, strokeLines/2, drawRoundedRectangle/6,
drawText/4, getTextExtent/2]).
@@ -244,28 +244,18 @@ handle_event(Event, _State) ->
%%%%%%%%%%
handle_sync_event(#wx{event = #wxPaint{}},_,
#state{app_w=DA, app=App, sel=Sel, paint=Paint, usegc=UseGC}) ->
- %% PaintDC must be created in a callback to work on windows.
- IsWindows = element(1, os:type()) =:= win32,
- %% Avoid Windows flickering hack
- DC = if IsWindows -> wx:typeCast(wxBufferedPaintDC:new(DA), wxPaintDC);
- true -> wxPaintDC:new(DA)
- end,
- IsWindows andalso wxDC:clear(DC),
- GC = case UseGC of
- true ->
- GC0 = ?wxGC:create(DC),
- %% Argh must handle scrolling when using ?wxGC
- {Sx,Sy} = wxScrolledWindow:calcScrolledPosition(DA, {0,0}),
- ?wxGC:translate(GC0, Sx,Sy),
- GC0;
- false ->
- wxScrolledWindow:doPrepareDC(DA,DC),
- DC
- end,
+ GC = {GC0, DC} = make_gc(DA, UseGC),
+ case UseGC of
+ false ->
+ wxScrolledWindow:doPrepareDC(DA,DC);
+ true ->
+ %% Argh must handle scrolling when using ?wxGC
+ {Sx,Sy} = wxScrolledWindow:calcScrolledPosition(DA, {0,0}),
+ ?wxGC:translate(GC0, Sx,Sy)
+ end,
%% Nothing is drawn until wxPaintDC is destroyed.
- draw({UseGC, GC}, App, Sel, Paint),
- UseGC andalso ?wxGC:destroy(GC),
- wxPaintDC:destroy(DC),
+ draw(GC, App, Sel, Paint),
+ destroy_gc(GC),
ok.
%%%%%%%%%%
handle_call(Event, From, _State) ->
@@ -312,15 +302,10 @@ handle_info({delivery, _Pid, app, _Curr, {[], [], [], []}},
handle_info({delivery, Pid, app, Curr, AppData},
State = #state{panel=Panel, appmon=Pid, current=Curr, usegc=UseGC,
app_w=AppWin, paint=#paint{font=Font}}) ->
- GC = if UseGC -> ?wxGC:create(AppWin);
- true -> wxWindowDC:new(AppWin)
- end,
- FontW = {UseGC, GC},
- setFont(FontW, Font, {0,0,0}),
- App = build_tree(AppData, FontW),
- if UseGC -> ?wxGC:destroy(GC);
- true -> wxWindowDC:destroy(GC)
- end,
+ GC = make_gc(AppWin, UseGC),
+ setFont(GC, Font, {0,0,0}),
+ App = build_tree(AppData, GC),
+ destroy_gc(GC),
setup_scrollbar(AppWin, App),
wxWindow:refresh(Panel),
wxWindow:layout(Panel),
diff --git a/lib/observer/src/observer_defs.hrl b/lib/observer/src/observer_defs.hrl
index 1c2fe520b7..c4ba84a8c4 100644
--- a/lib/observer/src/observer_defs.hrl
+++ b/lib/observer/src/observer_defs.hrl
@@ -49,3 +49,14 @@
-define(LCTRL_WDECR, 4). %% Remove some pixels in column width to avoid creating unnecessary scrollbar
-define(SASH_STYLE, ?wxSP_LIVE_UPDATE bor ?wxSP_NOBORDER bor ?wxSP_3DSASH).
+
+-define(DISP_FREQ, 10). %% per second
+-define(FETCH_DATA, 2). %% per second
+-define(DISP_SECONDS, 60).
+
+-record(ti, {tick=0, disp=?DISP_FREQ/?FETCH_DATA, fetch=?FETCH_DATA, secs=?DISP_SECONDS}).
+
+-record(win, {name, panel, size, geom,
+ graphs=[], no_samples=0,
+ max, state,
+ info=[]}).
diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl
index ace0b62c1d..56da5a862a 100644
--- a/lib/observer/src/observer_perf_wx.erl
+++ b/lib/observer/src/observer_perf_wx.erl
@@ -25,8 +25,9 @@
handle_event/2, handle_sync_event/3, handle_cast/2]).
%% Drawing wrappers for DC and GC areas
--export([setup_graph_drawing/1, refresh_panel/6,
- haveGC/0,
+-export([make_win/4, setup_graph_drawing/1,
+ refresh_panel/4, precalc/4, add_data/5, interval_dialog/2,
+ haveGC/0, make_gc/2, destroy_gc/1,
setPen/2, setFont/3, setBrush/2,
strokeLine/5, strokeLines/2, drawRoundedRectangle/6,
drawText/4, getTextExtent/2]).
@@ -35,13 +36,18 @@
-include_lib("wx/include/wx.hrl").
-include("observer_defs.hrl").
+-define(ID_REFRESH_INTERVAL, 102).
+
+-define(BW, 5).
+-define(BH, 5).
+
-record(state,
{
- offset = 0.0,
+ time = #ti{},
active = false,
parent,
- windows,
- data = {0, queue:new()},
+ samples, %% Orig data store
+ wins=[], %% per window content
panel,
paint,
appmon
@@ -51,49 +57,49 @@
-record(paint, {font, small, pen, pen2, pens, usegc = false}).
--define(RQ_W, 1).
--define(MEM_W, 2).
--define(IO_W, 3).
-
start_link(Notebook, Parent) ->
wx_object:start_link(?MODULE, [Notebook, Parent], []).
init([Notebook, Parent]) ->
- try
- Panel = wxPanel:new(Notebook),
- Main = wxBoxSizer:new(?wxVERTICAL),
+ try
+ Panel = wxPanel:new(Notebook),
+ Main = wxBoxSizer:new(?wxVERTICAL),
+ MemIO = wxBoxSizer:new(?wxHORIZONTAL),
+
+ CPU = make_win(runq, Panel, Main, ?wxALL),
+ MEM = make_win(memory, Panel, MemIO, ?wxLEFT),
+ IO = make_win(io, Panel, MemIO, ?wxLEFT bor ?wxRIGHT),
+
+ wxSizer:add(Main, MemIO, [{flag, ?wxEXPAND bor ?wxDOWN},
+ {proportion, 1}, {border, 5}]),
+ wxWindow:setSizer(Panel, Main),
+ Windows = [CPU, MEM, IO],
+ PaintInfo = setup_graph_drawing(Windows),
+
+ process_flag(trap_exit, true),
+ State0 = #state{parent=Parent,
+ panel =Panel,
+ wins = Windows,
+ paint=PaintInfo,
+ samples=reset_data()
+ },
+ {Panel, State0}
+ catch _:Err ->
+ io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]),
+ {stop, Err}
+ end.
+
+make_win(Name, Parent, Sizer, Border) ->
Style = ?wxFULL_REPAINT_ON_RESIZE bor ?wxCLIP_CHILDREN,
- CPU = wxPanel:new(Panel, [{winid, ?RQ_W}, {style,Style}]),
- wxSizer:add(Main, CPU, [{flag, ?wxEXPAND bor ?wxALL},
- {proportion, 1}, {border, 5}]),
- MemIO = wxBoxSizer:new(?wxHORIZONTAL),
- MEM = wxPanel:new(Panel, [{winid, ?MEM_W}, {style,Style}]),
- IO = wxPanel:new(Panel, [{winid, ?IO_W}, {style,Style}]),
- wxSizer:add(MemIO, MEM, [{flag, ?wxEXPAND bor ?wxLEFT},
- {proportion, 1}, {border, 5}]),
- wxSizer:add(MemIO, IO, [{flag, ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT},
- {proportion, 1}, {border, 5}]),
- wxSizer:add(Main, MemIO, [{flag, ?wxEXPAND bor ?wxDOWN},
- {proportion, 1}, {border, 5}]),
- wxWindow:setSizer(Panel, Main),
-
- PaintInfo = setup_graph_drawing([CPU, MEM, IO]),
-
- process_flag(trap_exit, true),
- {Panel, #state{parent=Parent,
- panel =Panel,
- windows = {CPU, MEM, IO},
- paint=PaintInfo
- }}
- catch _:Err ->
- io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]),
- {stop, Err}
- end.
+ Panel = wxPanel:new(Parent, [{style,Style}]),
+ Opts = [{flag, ?wxEXPAND bor Border}, {proportion, 1}, {border, 5}],
+ wxSizer:add(Sizer, Panel, Opts),
+ #win{name=Name, panel=Panel}.
setup_graph_drawing(Panels) ->
IsWindows = element(1, os:type()) =:= win32,
IgnoreCB = {callback, fun(_,_) -> ok end},
- Do = fun(Panel) ->
+ Do = fun(#win{panel=Panel}) ->
wxWindow:setBackgroundColour(Panel, ?wxWHITE),
wxPanel:connect(Panel, paint, [callback]),
IsWindows andalso
@@ -117,8 +123,8 @@ setup_graph_drawing(Panels) ->
SF = wxFont:new(DefSize-2, DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL),
{F, SF}
end,
- BlackPen = wxPen:new({0,0,0}, [{width, 2}]),
- Pens = [wxPen:new(Col, [{width, 3}]) || Col <- tuple_to_list(colors())],
+ BlackPen = wxPen:new({0,0,0}, [{width, 1}]),
+ Pens = [wxPen:new(Col, [{width, 1}]) || Col <- tuple_to_list(colors())],
#paint{usegc = UseGC,
font = Font,
small = SmallFont,
@@ -129,7 +135,16 @@ setup_graph_drawing(Panels) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
+handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_selected}},
+ #state{panel=Panel, appmon=Old, wins=Wins0, time=#ti{fetch=F0} = Ti0} = State) ->
+ case interval_dialog(Panel, Ti0) of
+ Ti0 -> {noreply, State};
+ #ti{fetch=F0} = Ti -> %% Same fetch interval force refresh
+ Wins = [W#win{max=undefined} || W <- Wins0],
+ {noreply, precalc(State#state{time=Ti, wins=Wins})};
+ Ti -> %% Changed fetch interval, drop all data
+ {noreply, restart_fetcher(node(Old), State#state{time=Ti})}
+ end;
handle_event(#wx{event=#wxCommand{type=command_menu_selected}},
State = #state{}) ->
{noreply, State};
@@ -139,41 +154,21 @@ handle_event(Event, _State) ->
%%%%%%%%%%
handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_,
- #state{active=Active, offset=Offset, paint=Paint,
- windows=Windows, data=Data}) ->
+ #state{active=Active, time=Ti, paint=Paint, wins=Windows}) ->
%% Sigh workaround bug on MacOSX (Id in paint event is always 0)
%% Panel = element(Id, Windows),
- Id = if Panel =:= element(?RQ_W, Windows) -> runq;
- Panel =:= element(?MEM_W, Windows) -> memory;
- Panel =:= element(?IO_W, Windows) -> io
- end,
-
- refresh_panel(Panel, Id, Offset, Data, Active, Paint),
+ Win = lists:keyfind(Panel, #win.panel, Windows),
+ refresh_panel(Active, Win, Ti, Paint),
ok.
-refresh_panel(Panel, Id, Offset, Data, Active, #paint{usegc=UseGC} = Paint) ->
+refresh_panel(Active, #win{name=_Id, panel=Panel}=Win, Ti, #paint{usegc=UseGC}=Paint) ->
%% PaintDC must be created in a callback to work on windows.
- IsWindows = element(1, os:type()) =:= win32,
- DC = if IsWindows ->
- %% Ugly hack to aviod flickering on windows, works on windows only
- %% But the other platforms are doublebuffered by default
- wx:typeCast(wxBufferedPaintDC:new(Panel), wxPaintDC);
- true ->
- wxPaintDC:new(Panel)
- end,
- IsWindows andalso wxDC:clear(DC),
- GC = if UseGC -> ?wxGC:create(DC);
- true -> DC
- end,
%% Nothing is drawn until wxPaintDC is destroyed.
- try
- draw(Offset, Id, {UseGC, GC}, Panel, Paint, Data, Active)
- catch _:Err ->
- io:format("Internal error ~p ~p~n",[Err, erlang:get_stacktrace()])
+ GC = make_gc(Panel, UseGC),
+ if Active -> draw_win(GC, Win, Ti, Paint);
+ true -> ignore
end,
- UseGC andalso ?wxGC:destroy(GC),
- wxPaintDC:destroy(DC).
-
+ destroy_gc(GC).
%%%%%%%%%%
handle_call(Event, From, _State) ->
@@ -182,41 +177,42 @@ handle_call(Event, From, _State) ->
handle_cast(Event, _State) ->
error({unhandled_cast, Event}).
%%%%%%%%%%
-handle_info(Stats = {stats, 1, _, _, _},
- State = #state{panel=Panel, data=Data, active=Active}) ->
+handle_info({stats, 1, _, _, _} = Stats,
+ #state{panel=Panel, samples=Data, active=Active, wins=Wins0,
+ time=#ti{tick=Tick, disp=Disp0}=Ti} = State0) ->
if Active ->
+ Disp = trunc(Disp0),
+ Next = max(Tick - Disp, 0),
+ erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}),
+ {Wins, Samples} = add_data(Stats, Data, Wins0, Ti, Active),
+ State = precalc(State0#state{time=Ti#ti{tick=Next}, wins=Wins, samples=Samples}),
wxWindow:refresh(Panel),
- Freq = 6,
- erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq});
- true -> ignore
- end,
- {noreply, State#state{offset=0.0, data = add_data(Stats, Data)}};
-
-handle_info({refresh, Seq, Freq}, State = #state{panel=Panel, offset=Prev}) ->
- wxWindow:refresh(Panel),
- Next = Seq+1,
- if Seq > 1, Prev =:= 0.0 ->
- %% We didn't have time to handle the refresh
{noreply, State};
- Next < Freq ->
- erlang:send_after(trunc(1000 / Freq), self(), {refresh, Next, Freq}),
- {noreply, State#state{offset=Seq/Freq}};
true ->
- {noreply, State#state{offset=Seq/Freq}}
+ {Wins1, Samples} = add_data(Stats, Data, Wins0, Ti, Active),
+ Wins = [W#win{max=undefined} || W <- Wins1],
+ {noreply, State0#state{samples=Samples, wins=Wins, time=Ti#ti{tick=0}}}
end;
-handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Old}) ->
+handle_info({refresh, Seq}, #state{panel=Panel, time=#ti{tick=Seq, disp=DispF}=Ti} = State0)
+ when (Seq+1) < (DispF*1.5) ->
+ Next = Seq+1,
+ erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}),
+ State = precalc(State0#state{time=Ti#ti{tick=Next}}),
+ catch wxWindow:refresh(Panel),
+ {noreply, State};
+handle_info({refresh, _}, State) ->
+ {noreply, State};
+
+handle_info({active, Node}, #state{parent=Parent, panel=Panel, appmon=Old, time=_Ti} = State) ->
create_menus(Parent, []),
try
Node = node(Old),
wxWindow:refresh(Panel),
+ erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}),
{noreply, State#state{active=true}}
catch _:_ ->
- catch Old ! exit,
- Me = self(),
- Pid = spawn_link(Node, observer_backend, fetch_stats, [Me, 1000]),
- wxWindow:refresh(Panel),
- {noreply, State#state{active=true, appmon=Pid, data={0, queue:new()}}}
+ {noreply,restart_fetcher(Node, State)}
end;
handle_info(not_active, State = #state{appmon=_Pid}) ->
@@ -237,173 +233,337 @@ terminate(_Event, #state{appmon=Pid}) ->
code_change(_, _, State) ->
State.
-add_data(Stats, {N, Q}) when N > 60 ->
- {N, queue:drop(queue:in(Stats, Q))};
-add_data(Stats, {N, Q}) ->
- {N+1, queue:in(Stats, Q)}.
+restart_fetcher(Node, #state{appmon=Old, panel=Panel, time=#ti{fetch=Freq}=Ti}=State) ->
+ catch Old ! exit,
+ Me = self(),
+ Pid = spawn_link(Node, observer_backend, fetch_stats, [Me, round(1000/Freq)]),
+ wxWindow:refresh(Panel),
+ precalc(State#state{active=true, appmon=Pid, samples=reset_data(), time=Ti#ti{tick=0}}).
+
+reset_data() ->
+ {0, queue:new()}.
+
+add_data(Stats, {N, Q0}, Wins, #ti{fetch=Fetch, secs=Secs}, Active) when N > (Secs*Fetch+1) ->
+ {{value, Drop}, Q} = queue:out(Q0),
+ add_data_1(Wins, Stats, N, {Drop,Q}, Active);
+add_data(Stats, {N, Q}, Wins, _, Active) ->
+ add_data_1(Wins, Stats, N+1, {empty, Q}, Active).
+
+add_data_1([#win{state={_,St}}|_]=Wins0, Last, N, {Drop, Q}, Active)
+ when St /= undefined ->
+ {Wins, Stat} =
+ lists:mapfoldl(fun(Win0, Entry) ->
+ {Win1,Stat} = add_data_2(Win0, Last, Entry),
+ case Active of
+ true ->
+ Win = add_data_3(Win1, N, Drop, Stat, Q),
+ {Win, Stat};
+ false ->
+ {Win1, Stat}
+ end
+ end, #{}, Wins0),
+ {Wins, {N,queue:in(Stat#{}, Q)}};
+add_data_1(Wins, Stats, 1, {_, Q}, _) ->
+ {[Win#win{state=init_data(Id, Stats),
+ info = info(Id, Stats)}
+ || #win{name=Id}=Win <- Wins], {0,Q}}.
+
+add_data_2(#win{name=Id, state=S0}=Win, Stats, Map) ->
+ {V1, S1} = collect_data(Id, Stats, S0),
+ {Win#win{state=S1}, Map#{Id=>V1}}.
+
+add_data_3(#win{name=Id, max={{OldMax, OldEntry},_,_,_},
+ geom=#{scale:={WS,HS}}, state={Max,_},
+ graphs=Graphs}=Win,
+ N, Drop0, Last, Q1)
+ when N > 3 ->
+ Drop = case Drop0 of
+ #{Id:=D} -> D;
+ _ -> Drop0
+ end,
+ case {max_value(Max), Drop =:= OldEntry} of
+ {OldMax, false} ->
+ #{Id:=V4} = Last,
+ {{value, #{Id:=V3}},Q2} = queue:out_r(Q1),
+ {{value, #{Id:=V2}},Q3} = queue:out_r(Q2),
+ {{value, #{Id:=V1}},_} = queue:out_r(Q3),
+ Vals = [V1,V2,V3,V4],
+ Gs = tuple_size(V1),
+ Info = lists:zip(lists:seq(Gs, 1, -1), Graphs),
+ Lines = [add_lines(Vals, Drop, Prev, I, WS, HS) || {I, Prev} <- Info],
+ Win#win{graphs=Lines, no_samples=N};
+ _W -> %% Max changed Trigger complete recalc
+ Win#win{max=undefined}
+ end;
+add_data_3(Win, _, _, _,_) ->
+ %% Trigger complete recalc
+ Win#win{max=undefined}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
create_menus(Parent, _) ->
- MenuEntries =
- [{"File",
- [
- ]}
- ],
- observer_wx:create_menus(Parent, MenuEntries).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-collect_data(runq, {N, Q}) ->
- case queue:to_list(Q) of
- [] -> {0, 0, [], []};
- [_] -> {0, 0, [], []};
- [{stats, _Ver, Init0, _IO, _Mem}|Data0] ->
- Init = lists:sort(Init0),
- [_|Data=[First|_]] = lists:foldl(fun({stats, _, T0, _, _}, [Prev|Acc]) ->
- TN = lists:sort(T0),
- Delta = calc_delta(TN, Prev),
- [TN, list_to_tuple(Delta)|Acc]
- end, [Init], Data0),
- NoGraphs = tuple_size(First),
- {N, lmax(Data), lists:reverse([First|Data]), lists:seq(1, NoGraphs)}
- end;
-collect_data(memory, {N, Q}) ->
- MemT = mem_types(),
- Data = [list_to_tuple([Value || {Type,Value} <- MemInfo,
- lists:member(Type, MemT)])
- || {stats, _Ver, _RQ, _IO, MemInfo} <- queue:to_list(Q)],
- {N, lmax(Data), Data, MemT};
-collect_data(io, {N, Q}) ->
- case queue:to_list(Q) of
- [] -> {0, 0, [], []};
- [_] -> {0, 0, [], []};
- [{stats, _Ver, _RQ, {{_,In0}, {_,Out0}}, _Mem}|Data0] ->
- [_,_|Data=[First|_]] =
- lists:foldl(fun({stats, _, _, {{_,In}, {_,Out}}, _}, [PIn,Pout|Acc]) ->
- [In,Out,{In-PIn,Out-Pout}|Acc]
- end, [In0,Out0], Data0),
- {N, lmax(Data), lists:reverse([First|Data]), [input, output]}
- end;
-collect_data(alloc, {N, Q}) ->
- List = queue:to_list(Q),
- Data = [list_to_tuple([Carrier || {_Type,_Block,Carrier} <- MemInfo])
- || MemInfo <- List],
- Info = case List of %% Varies depending on erlang build config/platform
- [MInfo|_] -> [Type || {Type, _, _} <- MInfo];
- _ -> []
- end,
- {N, lmax(Data), Data, Info};
-
-collect_data(utilz, {N, Q}) ->
- List = queue:to_list(Q),
- Data = [list_to_tuple([round(100*Block/Carrier) || {_Type,Block,Carrier} <- MemInfo])
- || MemInfo <- List],
- Info = case List of %% Varies depending on erlang build config/platform
- [MInfo|_] -> [Type || {Type, _, _} <- MInfo];
- _ -> []
- end,
- {N, lmax(Data), Data, Info}.
+ View = {"View", [#create_menu{id = ?ID_REFRESH_INTERVAL, text = "Graph Settings"}]},
+ observer_wx:create_menus(Parent, [{"File", []}, View]).
+
+interval_dialog(Parent0, #ti{fetch=Fetch0, secs=Secs0}=Ti) ->
+ Parent = observer_lib:get_wx_parent(Parent0),
+ Dialog = wxDialog:new(Parent, ?wxID_ANY, "Load Chart Settings",
+ [{style, ?wxDEFAULT_DIALOG_STYLE bor
+ ?wxRESIZE_BORDER}]),
+ {Sl1,FetchSl} = slider(Dialog, "Sample (ms)", trunc(1000 / Fetch0), 100, 10000),
+ {Sl2, SecsSl} = slider(Dialog, "Length (min)", Secs0 div 60, 1, 10),
+ TopSizer = wxBoxSizer:new(?wxVERTICAL),
+ Flags = [{flag, ?wxEXPAND bor ?wxTOP bor ?wxLEFT bor ?wxRIGHT},
+ {border, 5}, {proportion, 1}],
+ wxSizer:add(TopSizer, Sl1, Flags),
+ wxSizer:add(TopSizer, Sl2, Flags),
+ wxSizer:add(TopSizer, wxDialog:createButtonSizer(Dialog, ?wxOK bor ?wxCANCEL), Flags),
+ wxWindow:setSizerAndFit(Dialog, TopSizer),
+ wxSizer:setSizeHints(TopSizer, Dialog),
+ Res = case wxDialog:showModal(Dialog) of
+ ?wxID_OK ->
+ Fetch = 1000 / wxSlider:getValue(FetchSl),
+ Secs = wxSlider:getValue(SecsSl) * 60,
+ Ti#ti{fetch=Fetch, secs=Secs, disp=?DISP_FREQ/Fetch};
+ ?wxID_CANCEL ->
+ Ti
+ end,
+ wxDialog:destroy(Dialog),
+ Res.
+
+slider(Parent, Str, Value, Min, Max) ->
+ Sz = wxBoxSizer:new(?wxHORIZONTAL),
+ Center = [{flag, ?wxALIGN_CENTER_VERTICAL}],
+ wxSizer:add(Sz, wxStaticText:new(Parent, ?wxID_ANY, Str), [{proportion, 1}|Center]),
+ Opt = [{style, ?wxSL_HORIZONTAL bor ?wxSL_LABELS}],
+ Slider = wxSlider:new(Parent, ?wxID_ANY, Value, Min, Max, Opt),
+ wxSizer:add(Sz, Slider, [{proportion, 2}|Center]),
+ case Min > 1 of
+ false ->
+ {Sz, Slider};
+ true ->
+ CB = fun(#wx{event=Ev},_) -> step(Ev, Slider, Min) end,
+ wxSlider:connect(Slider, scroll_thumbtrack, [{callback, CB}]),
+ wxSlider:connect(Slider, scroll_changed, [{callback, CB}]),
+ {Sz, Slider}
+ end.
+step(_Ev = #wxScroll{commandInt=Value}, Slider, Min) ->
+ Val = Min * round(Value / Min),
+ wxSlider:setValue(Slider, Val),
+ ok.
-mem_types() ->
- [total, processes, atom, binary, code, ets].
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-lmax([]) -> 0;
-lmax(List) ->
- Max = [lists:max(tuple_to_list(T)) || T <- List,
- tuple_size(T) > 0],
- case Max of
- [] -> 0;
- _ -> lists:max(Max)
+mk_max() -> {0, undefined}.
+max_value({Max,_}) -> Max.
+%% max_data({_,Data}) -> Data. matched in function head
+
+lmax(MState, Tuple, Tuple) when is_tuple(Tuple) ->
+ lmax(MState, tuple_to_list(Tuple), Tuple);
+lmax(MState, Values, State) ->
+ Max = max_value(MState),
+ New = lists:max([Max|Values]),
+ case New >= Max of
+ false -> MState;
+ true -> {New, State}
end.
+init_data(runq, {stats, _, T0, _, _}) -> {mk_max(),lists:sort(T0)};
+init_data(io, {stats, _, _, {{_,In0}, {_,Out0}}, _}) -> {mk_max(), {In0,Out0}};
+init_data(memory, _) -> {mk_max(), info(memory, undefined)};
+init_data(alloc, _) -> {mk_max(), ok};
+init_data(utilz, _) -> {mk_max(), ok}.
+
+info(runq, {stats, _, T0, _, _}) -> lists:seq(1, length(T0));
+info(memory, _) -> [total, processes, atom, binary, code, ets];
+info(io, _) -> [input, output];
+info(alloc, First) -> [Type || {Type, _, _} <- First];
+info(utilz, First) -> [Type || {Type, _, _} <- First];
+info(_, []) -> [].
+
+collect_data(runq, {stats, _, T0, _, _}, {Max,S0}) ->
+ S1 = lists:sort(T0),
+ Delta = calc_delta(S1, S0),
+ Sample = list_to_tuple(Delta),
+ {Sample, {lmax(Max,Delta,Sample), S1}};
+collect_data(io, {stats, _, _, {{_,In0}, {_,Out0}}, _}, {Max,{PIn,POut}}) ->
+ In = In0-PIn,
+ Out = Out0-POut,
+ Sample = {In, Out},
+ {Sample, {lmax(Max, [In,Out], Sample), {In0, Out0}}};
+collect_data(memory, {stats, _, _, _, MemInfo}, {Max, MemTypes}) ->
+ Vs = [Value || {Type,Value} <- MemInfo, lists:member(Type, MemTypes)],
+ Sample = list_to_tuple(Vs),
+ {Sample, {lmax(Max, Vs, Sample),MemTypes}};
+collect_data(alloc, MemInfo, Max) ->
+ Vs = [Carrier || {_Type,_Block,Carrier} <- MemInfo],
+ Sample = list_to_tuple(Vs),
+ {Sample, lmax(Max, Vs, Sample)};
+collect_data(utilz, MemInfo, Max) ->
+ Vs = [round(100*Block/Carrier) || {_Type,Block,Carrier} <- MemInfo],
+ Sample = list_to_tuple(Vs),
+ {Sample, lmax(Max,Vs,Sample)}.
+
calc_delta([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) ->
[100*(WN-WP) div (TN-TP)|calc_delta(Ss, Ps)];
calc_delta([], []) -> [].
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-draw(Offset, Id, DC, Panel, Paint=#paint{pens=Pens, small=Small}, Data, Active) ->
- %% This can be optimized a lot by collecting data once
- %% and draw to memory and then blit memory and only draw new entries in new memory
- %% area. Hmm now rewritten to use ?wxGC I don't now if it is feasable.
- {Len, Max0, Hs, Info} = collect_data(Id, Data),
- {Max,_,_} = MaxDisp = calc_max(Id, Max0),
+precalc(#state{samples=Data0, paint=Paint, time=Ti, wins=Wins0}=State) ->
+ Wins = [precalc(Ti, Data0, Paint, Win) || Win <- Wins0],
+ State#state{wins=Wins}.
+
+precalc(Ti, {NoSamples,Q}, Paint, #win{name=Id, panel=Panel}=Win) ->
Size = wxWindow:getClientSize(Panel),
- {X0,Y0,WS,HS, DrawBs} = draw_borders(Id, Info, DC, Size, MaxDisp, Paint),
- Last = 60*WS+X0-1,
- Start = max(61-Len, 0)*WS+X0 - Offset*WS,
- Samples = length(Hs),
- NoGraphs = try tuple_size(hd(Hs)) catch _:_ -> 0 end,
- case Active andalso Samples > 1 andalso NoGraphs > 0 of
- true ->
- Draw = fun(N) ->
- Lines = make_lines(Hs, Start, N, {X0,Max*HS,Last}, Y0, WS, HS),
- setPen(DC, element(1+ ((N-1) rem tuple_size(Pens)), Pens)),
- strokeLines(DC, Lines),
- N+1
- end,
- [Draw(I) || I <- lists:seq(NoGraphs, 1, -1)],
- DrawBs();
- false ->
- DrawBs(),
- Text = case Active andalso Samples =< 1 of
+ case Win of
+ #win{max=Max, no_samples=NoSamples, size=Size} when is_tuple(Max) ->
+ Win;
+ _SomeThingChanged ->
+ Hs = [Vals || #{Id:=Vals} <- queue:to_list(Q)],
+ Max = lists:foldl(fun(Vals,Max) -> lmax(Max, Vals, Vals) end,
+ mk_max(), Hs),
+ MaxDisp = calc_max(Id, Max),
+ #{scale:={WS,HS}} = Props = window_geom(Size, MaxDisp, Ti, Panel, Paint),
+ NoGraphs = try tuple_size(hd(Hs)) catch _:_ -> 0 end,
+ Graphs = [make_lines(Hs, I, WS, HS) || I <- lists:seq(NoGraphs, 1, -1)],
+ State = case Win#win.state of
+ undefined -> {Max, undefined};
+ {_, St} -> {Max, St}
+ end,
+ Win#win{geom=Props, size=Size,
+ max=MaxDisp,
+ graphs=Graphs,
+ no_samples=NoSamples,
+ state=State}
+ end.
+
+window_geom({W,H}, {_, Max, _Unit, MaxUnit},
+ #ti{secs=Secs, fetch=FetchFreq},
+ Panel, #paint{font=Font}) ->
+ Str1 = observer_lib:to_str(MaxUnit),
+ Str2 = observer_lib:to_str(MaxUnit div 2),
+ Str3 = observer_lib:to_str(0),
+ {TW,TH,_,_} = wxWindow:getTextExtent(Panel, Str1, [{theFont, Font}]),
+ {SpaceW, _,_,_} = wxWindow:getTextExtent(Panel, "W", [{theFont, Font}]),
+ X0 = ?BW+TW+?BW,
+ X1 = W-?BW*4,
+ MaxTextY = TH+?BH,
+ BottomTextY = H-?BH-TH,
+ Y0 = MaxTextY + (TH / 2),
+ Y1 = BottomTextY - TH - ?BH,
+
+ ScaleW = (X1-X0-1)/(Secs*FetchFreq),
+ ScaleH = (Y1-Y0-1) / Max,
+ #{p0=>{X0,Y0}, p1=>{X1,Y1}, scale=>{ScaleW, ScaleH},
+ txsz=>{TW,TH,SpaceW}, txt=>{BottomTextY, MaxTextY}, strs=>{Str1,Str2,Str3}}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+draw_win(DC, #win{no_samples=Samples, geom=#{scale:={WS,HS}}, graphs=Graphs, max={_,Max,_,_}}=Win,
+ #ti{tick=Tick, fetch=FetchFreq, secs=Secs, disp=DispFreq}=Ti,
+ Paint=#paint{pens=Pens}) when Samples >= 2, Graphs =/= [] ->
+ %% Draw graphs
+ {X0,Y0,DrawBs} = draw_borders(DC, Ti, Win, Paint),
+ Offset = Tick / DispFreq,
+ Full = case Samples > (1+Secs*FetchFreq) of
+ true -> 1;
+ false -> 2
+ end,
+ Start = X0 + (max(Secs*FetchFreq+Full-Samples, 0) - Offset)*WS,
+ Last = Secs*FetchFreq*WS+X0,
+ Draw = fun(Lines0, N) ->
+ setPen(DC, element(1+ ((N-1) rem tuple_size(Pens)), Pens)),
+ Order = lists:reverse(Lines0),
+ [{_,Y}|Lines] = translate(Order, {Start, Y0}, 0, WS, {X0,Max*HS,Last}, []),
+ strokeLines(DC, [{Last,Y}|Lines]),
+ N-1
+ end,
+ lists:foldl(Draw, length(Graphs), Graphs),
+ DrawBs(),
+ ok;
+
+draw_win(DC, #win{no_samples=Samples} = Win,Ti, #paint{small=Small}=Paint) ->
+ %% Draw Error Msg
+ try draw_borders(DC, Ti, Win, Paint) of
+ {X0,_Y0,DrawBs} ->
+ Text = case Samples =< 1 of
true -> "Waiting for data";
false -> "Information not available"
end,
setFont(DC, Small, {0,0,0}),
- drawText(DC, Text, X0 + 100, element(2,Size) div 2)
- end,
- ok.
+ {_,WW} = getSize(DC),
+ drawText(DC, Text, X0 + 100, WW div 2),
+ DrawBs(),
+ ok
+ catch _:_ -> %% Early redraws fail
+ ok
+ end.
-make_lines(Ds = [Data|_], PX, N, Clip, ZeroY, WS, HS) ->
+translate([{X0,Y}|Rest], {Sx,Sy}=Start, N, WS, {Cx,Cy,Cw}=Clip, Acc) ->
+ X = min((N-X0)*WS+Sx,Cw),
+ Next = if X0 > 0 -> N; true -> N+1 end,
+ case X =< Cx of
+ true ->
+ translate(Rest, Start, Next, WS, Clip, [{Cx,Sy-min(Cy,Y)}]);
+ false ->
+ translate(Rest, Start, Next, WS, Clip, [{X,Sy-min(Cy,Y)}|Acc])
+ end;
+translate([], _, _, _, _, Acc) ->
+ Acc.
+
+add_lines(Vals, Drop, OldLines, I, WS, HS) ->
+ Lines = strip(OldLines, Drop, 2),
+ New = make_lines(Vals, I, WS, HS),
+ New ++ Lines.
+
+strip([{X,_}|Rest], Drop, N) when X > 0.0001, N > 0 ->
+ strip(Rest, Drop, N);
+strip([_|Rest], Drop, N) when N > 0 ->
+ strip(Rest, Drop, N-1);
+strip(List, empty, _) -> List;
+strip(List, _, _) ->
+ lists:reverse(strip(lists:reverse(List), empty, 1)).
+
+make_lines(Ds = [Data|_], N, WS, HS) ->
Y = element(N,Data),
- make_lines(Ds, PX, N, Clip, ZeroY, WS, HS, Y, []).
+ make_lines(Ds, N, WS, HS, Y, []).
-make_lines([D1 | Ds = [D2|Rest]], PX, N, Clip={Cx,Cy, _}, ZeroY, WS, HS, Y0, Acc0) ->
+make_lines([D1 | Ds = [D2|Rest]], N, WS, HS, Y0, Acc0) ->
Y1 = element(N,D1),
Y2 = element(N,D2),
Y3 = case Rest of
[D3|_] -> element(N,D3);
[] -> Y2
end,
- This = {max(Cx, PX),ZeroY-min(Cy,Y1*HS)},
+ This = {0, Y1*HS},
Acc = if (abs(Y1-Y2) * HS) < 3.0 -> [This|Acc0];
WS < 3.0 -> [This|Acc0];
- PX < Cx ->
- make_splines(Y0,Y1,Y2,Y3,PX,Clip,ZeroY,WS,HS,Acc0);
- true ->
- make_splines(Y0,Y1,Y2,Y3,PX,Clip,ZeroY,WS,HS,[This|Acc0])
+ true -> make_splines(Y0,Y1,Y2,Y3,WS,HS,[This|Acc0])
end,
- make_lines(Ds, PX+WS, N, Clip, ZeroY, WS, HS, Y1, Acc);
-make_lines([D1], _PX, N, {_,Cy,Last}, ZeroY, _WS, HS, _Y0, Acc) ->
- Y1 = element(N,D1),
- [{Last,ZeroY-min(Cy, Y1*HS)}|Acc].
+ make_lines(Ds, N, WS, HS, Y1, Acc);
+make_lines([_D1], _N, _WS, _HS, _Y0, Acc) ->
+ Acc.
-make_splines(Y00,Y10,Y20,Y30,PX,Clip,ZeroY,WS,HS,Acc) ->
+make_splines(Y00,Y10,Y20,Y30,WS,HS,Acc) ->
Y1 = Y10*HS,
Y2 = Y20*HS,
- Steps = min(abs(Y1-Y2), WS),
+ Steps = min(abs(Y1-Y2), WS/2),
if Steps > 2 ->
Y0 = Y00*HS,
Y3 = Y30*HS,
Tan = spline_tan(Y0,Y1,Y2,Y3),
Delta = 1/Steps,
- splines(Steps-1, 0.0, Delta, Tan, Y1,Y2, PX, Clip,ZeroY, Delta*WS, Acc);
+ splines(Steps-1, 0.0, Delta, Tan, Y1,Y2, Acc);
true ->
Acc
end.
-splines(N, XD, XD0, Tan, Y1,Y2, PX0, Clip={Cx,Cy,_},ZeroY, WS, Acc) when N > 0 ->
- PX = PX0+WS,
+splines(N, XD, XD0, Tan, Y1,Y2, Acc) when N > 0 ->
Delta = XD+XD0,
- if PX < Cx ->
- splines(N-1, Delta, XD0, Tan, Y1, Y2, PX, Clip,ZeroY, WS, Acc);
- true ->
- Y = min(Cy, max(0,spline(Delta, Tan, Y1,Y2))),
- splines(N-1, Delta, XD0, Tan, Y1, Y2, PX, Clip,ZeroY, WS,
- [{PX, ZeroY-Y}|Acc])
- end;
-splines(_N, _XD, _XD0, _Tan, _Y1,_Y2, _PX, _Clip,_ZeroY, _WS, Acc) -> Acc.
+ Y = max(0, spline(Delta, Tan, Y1,Y2)),
+ splines(N-1, Delta, XD0, Tan, Y1, Y2, [{1.0-Delta, Y}|Acc]);
+splines(_N, _XD, _XD0, _Tan, _Y1,_Y2, Acc) ->
+ Acc.
spline(T, {M1, M2}, Y1, Y2) ->
%% Hermite Basis Funcs
@@ -423,34 +583,19 @@ spline_tan(Y0, Y1, Y2, Y3) ->
M2 = S*C*(Y3-Y1),
{M1,M2}.
--define(BW, 5).
--define(BH, 5).
-
-draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit},
+draw_borders(DC, #ti{secs=Secs, fetch=FetchFreq},
+ #win{name=Type, geom=Geom, info=Info, max={_,_,Unit,_}},
#paint{pen=Pen, pen2=Pen2, font=Font, small=Small}) ->
- Str1 = observer_lib:to_str(MaxUnit),
- Str2 = observer_lib:to_str(MaxUnit div 2),
- Str3 = observer_lib:to_str(0),
-
- setFont(DC, Font, {0,0,0}),
- {TW,TH} = getTextExtent(DC, Str1),
- {SpaceW, _} = getTextExtent(DC, "W"),
+ #{p0:={GraphX0, GraphY0}, p1:={GraphX1,GraphY1}, scale:={ScaleW0,_},
+ txsz:={TW,TH,SpaceW}, txt:={BottomTextY, MaxTextY}, strs:={Str1,Str2,Str3}} = Geom,
- GraphX0 = ?BW+TW+?BW,
- GraphX1 = W-?BW*4,
+ ScaleW = ScaleW0*FetchFreq,
TopTextX = ?BW*3+TW,
- MaxTextY = TH+?BH,
- BottomTextY = H-?BH-TH,
SecondsY = BottomTextY - TH,
- GraphY0 = MaxTextY + (TH / 2),
- GraphY1 = SecondsY - ?BH,
- GraphW = GraphX1-GraphX0-1,
- GraphH = GraphY1-GraphY0-1,
+
GraphY25 = GraphY0 + (GraphY1 - GraphY0) / 4,
GraphY50 = GraphY0 + (GraphY1 - GraphY0) / 2,
GraphY75 = GraphY0 + 3*(GraphY1 - GraphY0) / 4,
- ScaleW = GraphW / 60,
- ScaleH = GraphH / Max,
setFont(DC, Small, {0,0,0}),
Align = fun(Str, Y) ->
@@ -462,14 +607,21 @@ draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit},
Align(Str3, GraphY1 - (TH / 2) + 1),
setPen(DC, Pen),
- DrawSecs = fun(Secs, Pos) ->
- Str = [observer_lib:to_str(Secs)|" s"],
+ DrawSecs = fun(Sec, {Pos, Prev}) ->
+ Str = observer_lib:to_str(Sec) ++ "s",
X = GraphX0+Pos,
- drawText(DC, Str, X-SpaceW, SecondsY),
strokeLine(DC, X, GraphY0, X, GraphY1+5),
- Pos + 10*ScaleW
+ TxtX = X-SpaceW,
+ case TxtX > Prev of
+ true ->
+ drawText(DC, Str, TxtX, SecondsY),
+ TxtW = SpaceW*length(Str),
+ {Pos + 10*ScaleW, TxtX+TxtW};
+ false ->
+ {Pos + 10*ScaleW, Prev}
+ end
end,
- lists:foldl(DrawSecs, 0, lists:seq(60,0, -10)),
+ lists:foldl(DrawSecs, {0, 0}, lists:seq(Secs,0, -10)),
strokeLine(DC, GraphX0-3, GraphY25, GraphX1, GraphY25),
strokeLine(DC, GraphX0-3, GraphY50, GraphX1, GraphY50),
@@ -526,7 +678,7 @@ draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit},
{GraphX1, GraphY1+1}, {GraphX1, GraphY0-1},
{GraphX0, GraphY0-1}])
end,
- {GraphX0+1, GraphY1, ScaleW, ScaleH, DrawBorder}.
+ {GraphX0+1, GraphY1, DrawBorder}.
to_string(Atom) ->
Name = atom_to_list(Atom),
@@ -543,43 +695,44 @@ uppercase([C|Rest]) ->
calc_max(Type, Max) ->
bytes(Type, Max).
-calc_max1(Max) when Max < 10 ->
- 10;
-calc_max1(Max) ->
- case Max div 10 of
- X when X < 10 ->
- case Max rem 10 of
- 0 -> Max;
- _ ->
- (X+1)*10
- end;
- X ->
- 10*calc_max1(X)
- end.
-
-bytes(runq, Val) ->
- Upper = calc_max1(Val),
- {Upper, "", Upper};
-bytes(utilz, Val) ->
- Upper = calc_max1(Val),
- {Upper, "", Upper};
-bytes(_, B) ->
+bytes(runq, Max) ->
+ Upper = calc_max1(max_value(Max)),
+ {Max, Upper, "", Upper};
+bytes(utilz, Max) ->
+ Upper = calc_max1(max_value(Max)),
+ {Max, Upper, "", Upper};
+bytes(_, Max) ->
+ B = max_value(Max),
KB = B div 1024,
MB = KB div 1024,
GB = MB div 1024,
if
GB > 10 ->
Upper = calc_max1(GB),
- {Upper*1024*1024*1024, "(GB)", Upper};
+ {Max, Upper*1024*1024*1024, "(GB)", Upper};
MB > 10 ->
Upper = calc_max1(MB),
- {Upper*1024*1024, "(MB)", Upper};
+ {Max, Upper*1024*1024, "(MB)", Upper};
KB > 0 ->
Upper = calc_max1(KB),
- {Upper*1024, "(KB)", Upper};
+ {Max, Upper*1024, "(KB)", Upper};
true ->
Upper = calc_max1(B),
- {Upper, "(B)", Upper}
+ {Max, Upper, "(B)", Upper}
+ end.
+
+calc_max1(Max) when Max < 10 ->
+ 10;
+calc_max1(Max) ->
+ case Max div 10 of
+ X when X < 10 ->
+ case Max rem 10 of
+ 0 -> Max;
+ _ ->
+ (X+1)*10
+ end;
+ X ->
+ 10*calc_max1(X)
end.
colors() ->
@@ -592,6 +745,25 @@ colors() ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% wxDC and ?wxGC wrappers
+make_gc(Panel,UseGC) ->
+ DC = case os:type() of
+ {win32, _} ->
+ %% Ugly hack to avoid flickering on windows, works on windows only
+ %% But the other platforms are doublebuffered by default
+ DC0 = wx:typeCast(wxBufferedPaintDC:new(Panel), wxPaintDC),
+ wxDC:clear(DC0),
+ DC0;
+ _ ->
+ wxPaintDC:new(Panel)
+ end,
+ if UseGC -> {?wxGC:create(DC), DC};
+ true -> {false, DC}
+ end.
+
+destroy_gc({GC, DC}) ->
+ (GC =/= false) andalso ?wxGC:destroy(GC),
+ wxPaintDC:destroy(DC).
+
haveGC() ->
try
wxGraphicsRenderer:getDefaultRenderer(),
@@ -599,44 +771,48 @@ haveGC() ->
catch _:_ -> false
end.
+getSize({_, DC}) ->
+ wxDC:getSize(DC).
+
setPen({false, DC}, Pen) ->
wxDC:setPen(DC, Pen);
-setPen({true, GC}, Pen) ->
+setPen({GC, _}, Pen) ->
?wxGC:setPen(GC, Pen).
setFont({false, DC}, Font, Color) ->
wxDC:setTextForeground(DC, Color),
wxDC:setFont(DC, Font);
-setFont({true, GC}, Font, Color) ->
+setFont({GC, _}, Font, Color) ->
?wxGC:setFont(GC, Font, Color).
setBrush({false, DC}, Brush) ->
wxDC:setBrush(DC, Brush);
-setBrush({true, GC}, Brush) ->
+setBrush({GC, _}, Brush) ->
?wxGC:setBrush(GC, Brush).
strokeLine({false, DC}, X0, Y0, X1, Y1) ->
wxDC:drawLine(DC, {round(X0), round(Y0)}, {round(X1), round(Y1)});
-strokeLine({true, GC}, X0, Y0, X1, Y1) ->
+strokeLine({GC, _}, X0, Y0, X1, Y1) ->
?wxGC:strokeLine(GC, X0, Y0, X1, Y1).
+strokeLines(_, [_]) -> ok;
strokeLines({false, DC}, Lines) ->
wxDC:drawLines(DC, [{round(X), round(Y)} || {X,Y} <- Lines]);
-strokeLines({true, GC}, Lines) ->
+strokeLines({GC, _}, Lines) ->
?wxGC:strokeLines(GC, Lines).
drawRoundedRectangle({false, DC}, X0, Y0, X1, Y1, R) ->
wxDC:drawRoundedRectangle(DC, {round(X0), round(Y0)}, {round(X1), round(Y1)}, round(R));
-drawRoundedRectangle({true, GC}, X0, Y0, X1, Y1, R) ->
+drawRoundedRectangle({GC, _}, X0, Y0, X1, Y1, R) ->
?wxGC:drawRoundedRectangle(GC, X0, Y0, X1, Y1, R).
drawText({false, DC}, Str, X, Y) ->
wxDC:drawText(DC, Str, {round(X),round(Y)});
-drawText({true, GC}, Str, X, Y) ->
+drawText({GC, _}, Str, X, Y) ->
?wxGC:drawText(GC, Str, X, Y).
getTextExtent({false, DC}, Str) ->
wxDC:getTextExtent(DC, Str);
-getTextExtent({true, GC}, Str) ->
+getTextExtent({GC, _}, Str) ->
{W,H,_,_} = ?wxGC:getTextExtent(GC, Str),
{W,H}.
diff --git a/lib/observer/test/Makefile b/lib/observer/test/Makefile
index e8bb7d0a52..6100af5e17 100644
--- a/lib/observer/test/Makefile
+++ b/lib/observer/test/Makefile
@@ -45,8 +45,8 @@ RELSYSDIR = $(RELEASE_PATH)/observer_test
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
-ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_MAKE_FLAGS +=
+ERL_COMPILE_FLAGS +=
EBIN = .
@@ -60,8 +60,6 @@ make_emakefile:
$(MODULES) > $(EMAKEFILE)
tests debug opt: make_emakefile
- cd $(ERL_TOP)/lib/test_server/src && \
- $(MAKE) ../ebin/test_server_line.beam
erl $(ERL_MAKE_FLAGS) -make
clean:
diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl
index eea82d8c3c..e9a3ba0369 100644
--- a/lib/observer/test/crashdump_helper.erl
+++ b/lib/observer/test/crashdump_helper.erl
@@ -21,7 +21,7 @@
-module(crashdump_helper).
-export([n1_proc/2,remote_proc/2]).
-compile(r13).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
n1_proc(N2,Creator) ->
spawn(fun() -> n1_proc(Creator,N2,x,y,[]) end).
diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl
index 84af440245..2d47054600 100644
--- a/lib/observer/test/crashdump_viewer_SUITE.erl
+++ b/lib/observer/test/crashdump_viewer_SUITE.erl
@@ -30,7 +30,6 @@
-export([init_per_testcase/2, end_per_testcase/2]).
-include_lib("common_test/include/ct.hrl").
--include("test_server_line.hrl").
-include_lib("kernel/include/file.hrl").
-define(failed_file,"failed-cases.txt").
diff --git a/lib/observer/test/etop_SUITE.erl b/lib/observer/test/etop_SUITE.erl
index d4857c5e2f..4b05e4c2a0 100644
--- a/lib/observer/test/etop_SUITE.erl
+++ b/lib/observer/test/etop_SUITE.erl
@@ -26,7 +26,7 @@
-export([text/1,text/2,text_tracing_off/1,text_tracing_off/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").
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl
index 7f96d72e59..a33df61b98 100644
--- a/lib/observer/test/observer_SUITE.erl
+++ b/lib/observer/test/observer_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(observer_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("wx/include/wx.hrl").
-include_lib("observer/src/observer_tv.hrl").
diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl
index bdf10f507d..f1649e6cb9 100644
--- a/lib/observer/test/ttb_SUITE.erl
+++ b/lib/observer/test/ttb_SUITE.erl
@@ -32,7 +32,7 @@
-export([init_per_testcase/2, end_per_testcase/2]).
-export([foo/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(default_timeout, ?t:minutes(1)).
-define(OUTPUT, "handler_output").
diff --git a/lib/odbc/test/Makefile b/lib/odbc/test/Makefile
index 114eb5373d..4fecea3aae 100644
--- a/lib/odbc/test/Makefile
+++ b/lib/odbc/test/Makefile
@@ -21,7 +21,7 @@ include $(ERL_TOP)/make/target.mk
include $(ERL_TOP)/make/$(TARGET)/otp.mk
-INCLUDES= -I. -I$(ERL_TOP)/lib/test_server/include/ -I$(ERL_TOP)/lib/odbc/src
+INCLUDES= -I. -I$(ERL_TOP)/lib/odbc/src
# ----------------------------------------------------
# Target Specs
diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl
index 2d4173a008..41601a2750 100644
--- a/lib/odbc/test/odbc_connect_SUITE.erl
+++ b/lib/odbc/test/odbc_connect_SUITE.erl
@@ -26,7 +26,6 @@
-compile(export_all).
-include_lib("common_test/include/ct.hrl").
--include("test_server_line.hrl").
-include("odbc_test.hrl").
-define(MAX_SEQ_TIMEOUTS, 10).
diff --git a/lib/odbc/test/odbc_data_type_SUITE.erl b/lib/odbc/test/odbc_data_type_SUITE.erl
index a56af650c2..25988bef2a 100644
--- a/lib/odbc/test/odbc_data_type_SUITE.erl
+++ b/lib/odbc/test/odbc_data_type_SUITE.erl
@@ -27,7 +27,6 @@
-include_lib("common_test/include/ct.hrl").
-include_lib("stdlib/include/ms_transform.hrl").
--include("test_server_line.hrl").
-include("odbc_test.hrl").
%%--------------------------------------------------------------------
diff --git a/lib/odbc/test/odbc_query_SUITE.erl b/lib/odbc/test/odbc_query_SUITE.erl
index e8c2df7c31..79c756e956 100644
--- a/lib/odbc/test/odbc_query_SUITE.erl
+++ b/lib/odbc/test/odbc_query_SUITE.erl
@@ -26,7 +26,6 @@
-compile(export_all).
-include_lib("common_test/include/ct.hrl").
--include("test_server_line.hrl").
-include("odbc_test.hrl").
%%--------------------------------------------------------------------
diff --git a/lib/odbc/test/odbc_start_SUITE.erl b/lib/odbc/test/odbc_start_SUITE.erl
index 8fb564d1f9..e16b4cfb7f 100644
--- a/lib/odbc/test/odbc_start_SUITE.erl
+++ b/lib/odbc/test/odbc_start_SUITE.erl
@@ -26,7 +26,6 @@
-compile(export_all).
-include_lib("common_test/include/ct.hrl").
--include("test_server_line.hrl").
-include("odbc_test.hrl").
%% Test server callback functions
diff --git a/lib/odbc/test/odbc_test_lib.erl b/lib/odbc/test/odbc_test_lib.erl
index 6f49c019e3..88d772467c 100644
--- a/lib/odbc/test/odbc_test_lib.erl
+++ b/lib/odbc/test/odbc_test_lib.erl
@@ -26,7 +26,7 @@
-compile(export_all).
-include("odbc_test.hrl").
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
unique_table_name() ->
lists:reverse(lists:foldl(fun($@, Acc) -> [$t, $A |Acc] ;
diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile
index b9be48c790..1d4e3c70f0 100644
--- a/lib/orber/test/Makefile
+++ b/lib/orber/test/Makefile
@@ -162,12 +162,10 @@ TARGET_FILES = \
ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin
ERL_COMPILE_FLAGS += $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/test_server/ebin \
-pa $(ERL_TOP)/lib/ic/ebin \
-pa $(ERL_TOP)/lib/orber/ebin \
-I$(ERL_TOP)/lib/orber \
- -I$(ERL_TOP)/lib/orber/test/$(IDLOUTDIR) \
- -I$(ERL_TOP)/lib/test_server/include
+ -I$(ERL_TOP)/lib/orber/test/$(IDLOUTDIR)
# ----------------------------------------------------
# Targets
diff --git a/lib/orber/test/cdrcoding_10_SUITE.erl b/lib/orber/test/cdrcoding_10_SUITE.erl
index 1fec91dca3..dac6e78ddd 100644
--- a/lib/orber/test/cdrcoding_10_SUITE.erl
+++ b/lib/orber/test/cdrcoding_10_SUITE.erl
@@ -28,7 +28,7 @@
-include("idl_output/Module.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/cdrcoding_11_SUITE.erl b/lib/orber/test/cdrcoding_11_SUITE.erl
index 324b9b2b17..f4fe3d06e3 100644
--- a/lib/orber/test/cdrcoding_11_SUITE.erl
+++ b/lib/orber/test/cdrcoding_11_SUITE.erl
@@ -28,7 +28,7 @@
-include("idl_output/Module.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/cdrcoding_12_SUITE.erl b/lib/orber/test/cdrcoding_12_SUITE.erl
index f0a8fe4d7f..8843233d35 100644
--- a/lib/orber/test/cdrcoding_12_SUITE.erl
+++ b/lib/orber/test/cdrcoding_12_SUITE.erl
@@ -29,7 +29,7 @@
-module(cdrcoding_12_SUITE).
-include("idl_output/Module.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/cdrlib_SUITE.erl b/lib/orber/test/cdrlib_SUITE.erl
index dd1f975d9e..8fc9c655ce 100644
--- a/lib/orber/test/cdrlib_SUITE.erl
+++ b/lib/orber/test/cdrlib_SUITE.erl
@@ -26,7 +26,7 @@
%%-----------------------------------------------------------------
-module(cdrlib_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/orber/test/corba_SUITE.erl b/lib/orber/test/corba_SUITE.erl
index 914856f370..018d8b5f12 100644
--- a/lib/orber/test/corba_SUITE.erl
+++ b/lib/orber/test/corba_SUITE.erl
@@ -26,7 +26,7 @@
%%-----------------------------------------------------------------
-module(corba_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/csiv2_SUITE.erl b/lib/orber/test/csiv2_SUITE.erl
index 7f45f16ef7..cf4dbec073 100644
--- a/lib/orber/test/csiv2_SUITE.erl
+++ b/lib/orber/test/csiv2_SUITE.erl
@@ -21,7 +21,7 @@
-module(csiv2_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/data_types_SUITE.erl b/lib/orber/test/data_types_SUITE.erl
index d0e0eacad1..f910eecae7 100644
--- a/lib/orber/test/data_types_SUITE.erl
+++ b/lib/orber/test/data_types_SUITE.erl
@@ -26,7 +26,7 @@
-module(data_types_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/orber/test/generated_SUITE.erl b/lib/orber/test/generated_SUITE.erl
index cc14b4ebc0..7af355620e 100644
--- a/lib/orber/test/generated_SUITE.erl
+++ b/lib/orber/test/generated_SUITE.erl
@@ -26,7 +26,7 @@
-module(generated_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/orber/test/interceptors_SUITE.erl b/lib/orber/test/interceptors_SUITE.erl
index 57d5a5f831..ec30187aca 100644
--- a/lib/orber/test/interceptors_SUITE.erl
+++ b/lib/orber/test/interceptors_SUITE.erl
@@ -26,7 +26,7 @@
-module(interceptors_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/iop_ior_10_SUITE.erl b/lib/orber/test/iop_ior_10_SUITE.erl
index 5705a95710..edfe566dcd 100644
--- a/lib/orber/test/iop_ior_10_SUITE.erl
+++ b/lib/orber/test/iop_ior_10_SUITE.erl
@@ -26,7 +26,7 @@
%%-----------------------------------------------------------------
-module(iop_ior_10_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/src/orber_iiop.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/orber/test/iop_ior_11_SUITE.erl b/lib/orber/test/iop_ior_11_SUITE.erl
index b32da44c68..d24e3fb882 100644
--- a/lib/orber/test/iop_ior_11_SUITE.erl
+++ b/lib/orber/test/iop_ior_11_SUITE.erl
@@ -26,7 +26,7 @@
%%-----------------------------------------------------------------
-module(iop_ior_11_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/src/orber_iiop.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/orber/test/iop_ior_12_SUITE.erl b/lib/orber/test/iop_ior_12_SUITE.erl
index a12f341f04..725118b609 100644
--- a/lib/orber/test/iop_ior_12_SUITE.erl
+++ b/lib/orber/test/iop_ior_12_SUITE.erl
@@ -27,7 +27,7 @@
-module(iop_ior_12_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/src/orber_iiop.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/orber/test/ip_v4v6_interop_SUITE.erl b/lib/orber/test/ip_v4v6_interop_SUITE.erl
index 995a11ae1e..4840501418 100644
--- a/lib/orber/test/ip_v4v6_interop_SUITE.erl
+++ b/lib/orber/test/ip_v4v6_interop_SUITE.erl
@@ -47,7 +47,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/lname_SUITE.erl b/lib/orber/test/lname_SUITE.erl
index 2200ff6ed1..1fb4d7bbb9 100644
--- a/lib/orber/test/lname_SUITE.erl
+++ b/lib/orber/test/lname_SUITE.erl
@@ -26,7 +26,7 @@
%%-----------------------------------------------------------------
-module(lname_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/COSS/CosNaming/lname.hrl").
diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl
index 6b523229cc..abedcec407 100644
--- a/lib/orber/test/multi_ORB_SUITE.erl
+++ b/lib/orber/test/multi_ORB_SUITE.erl
@@ -21,7 +21,7 @@
-module(multi_ORB_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/naming_context_SUITE.erl b/lib/orber/test/naming_context_SUITE.erl
index f99820fa24..626b9237b5 100644
--- a/lib/orber/test/naming_context_SUITE.erl
+++ b/lib/orber/test/naming_context_SUITE.erl
@@ -26,7 +26,7 @@
%%-----------------------------------------------------------------
-module(naming_context_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
-include_lib("orber/include/corba.hrl").
diff --git a/lib/orber/test/orber_SUITE.erl b/lib/orber/test/orber_SUITE.erl
index 914705adb9..1ca22cd60b 100644
--- a/lib/orber/test/orber_SUITE.erl
+++ b/lib/orber/test/orber_SUITE.erl
@@ -19,7 +19,7 @@
%%
%%
-module(orber_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(default_timeout, ?t:minutes(15)).
-define(application, orber).
diff --git a/lib/orber/test/orber_acl_SUITE.erl b/lib/orber/test/orber_acl_SUITE.erl
index 8d1f9ebb6d..0d8f79de5c 100644
--- a/lib/orber/test/orber_acl_SUITE.erl
+++ b/lib/orber/test/orber_acl_SUITE.erl
@@ -26,7 +26,7 @@
%%-----------------------------------------------------------------
-module(orber_acl_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(default_timeout, ?t:minutes(5)).
diff --git a/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl b/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl
index 220029ec72..efa4f120c7 100644
--- a/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl
+++ b/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl
@@ -21,7 +21,7 @@
-module(orber_firewall_ipv4_in_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl b/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl
index 270b166fe9..cfe1ab2d95 100644
--- a/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl
+++ b/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl
@@ -21,7 +21,7 @@
-module(orber_firewall_ipv4_out_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl b/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl
index b0e28118f7..514504716f 100644
--- a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl
+++ b/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl
@@ -21,7 +21,7 @@
-module(orber_firewall_ipv6_in_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl b/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl
index 96884f3339..9ff57a0294 100644
--- a/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl
+++ b/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl
@@ -21,7 +21,7 @@
-module(orber_firewall_ipv6_out_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/orber_nat_SUITE.erl b/lib/orber/test/orber_nat_SUITE.erl
index 1294f96681..0751cdf89c 100644
--- a/lib/orber/test/orber_nat_SUITE.erl
+++ b/lib/orber/test/orber_nat_SUITE.erl
@@ -21,7 +21,7 @@
-module(orber_nat_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl
index 51025927ee..796ed21489 100644
--- a/lib/orber/test/orber_test_lib.erl
+++ b/lib/orber/test/orber_test_lib.erl
@@ -20,7 +20,7 @@
%%
-module(orber_test_lib).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/include/ifr_types.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/orber_web_SUITE.erl b/lib/orber/test/orber_web_SUITE.erl
index a88e0373bd..31c67be9d8 100644
--- a/lib/orber/test/orber_web_SUITE.erl
+++ b/lib/orber/test/orber_web_SUITE.erl
@@ -26,7 +26,7 @@
-module(orber_web_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/src/orber_iiop.hrl").
diff --git a/lib/orber/test/tc_SUITE.erl b/lib/orber/test/tc_SUITE.erl
index a1a5c74ae3..c670ebdea2 100644
--- a/lib/orber/test/tc_SUITE.erl
+++ b/lib/orber/test/tc_SUITE.erl
@@ -26,7 +26,7 @@
%%-----------------------------------------------------------------
-module(tc_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("orber/src/orber_iiop.hrl").
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/os_mon/test/Makefile b/lib/os_mon/test/Makefile
index cdfc13a4c1..aace77a3f0 100644
--- a/lib/os_mon/test/Makefile
+++ b/lib/os_mon/test/Makefile
@@ -55,8 +55,7 @@ RELSYSDIR = $(RELEASE_PATH)/os_mon_test
# FLAGS
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \
- -I$(ERL_TOP)/lib/snmp/include
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/snmp/include
# ----------------------------------------------------
# Targets
diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl
index e96b54d3fe..13d47c6a89 100644
--- a/lib/os_mon/test/cpu_sup_SUITE.erl
+++ b/lib/os_mon/test/cpu_sup_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(cpu_sup_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
diff --git a/lib/os_mon/test/disksup_SUITE.erl b/lib/os_mon/test/disksup_SUITE.erl
index e41fc73ab2..8e2825ec26 100644
--- a/lib/os_mon/test/disksup_SUITE.erl
+++ b/lib/os_mon/test/disksup_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(disksup_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
diff --git a/lib/os_mon/test/memsup_SUITE.erl b/lib/os_mon/test/memsup_SUITE.erl
index 8ab61e9581..904c9b95b0 100644
--- a/lib/os_mon/test/memsup_SUITE.erl
+++ b/lib/os_mon/test/memsup_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(memsup_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
diff --git a/lib/os_mon/test/os_mon_SUITE.erl b/lib/os_mon/test/os_mon_SUITE.erl
index 5c484ef2a6..0f7ae3a508 100644
--- a/lib/os_mon/test/os_mon_SUITE.erl
+++ b/lib/os_mon/test/os_mon_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(os_mon_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/os_mon/test/os_mon_mib_SUITE.erl b/lib/os_mon/test/os_mon_mib_SUITE.erl
index e68a139a74..f8fb9e20fc 100644
--- a/lib/os_mon/test/os_mon_mib_SUITE.erl
+++ b/lib/os_mon/test/os_mon_mib_SUITE.erl
@@ -30,7 +30,7 @@
%% > ct_run -suite os_mon_mib_SUITE -config os_mon_mib_SUITE.cfg
%%-----------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("os_mon/include/OTP-OS-MON-MIB.hrl").
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/os_mon/test/os_sup_SUITE.erl b/lib/os_mon/test/os_sup_SUITE.erl
index 768d95aebc..5857faa0a6 100644
--- a/lib/os_mon/test/os_sup_SUITE.erl
+++ b/lib/os_mon/test/os_sup_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(os_sup_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
diff --git a/lib/ose/Makefile b/lib/ose/Makefile
deleted file mode 100644
index 6119b75c3f..0000000000
--- a/lib/ose/Makefile
+++ /dev/null
@@ -1,37 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2009. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-#
-# Macros
-#
-
-SUB_DIRECTORIES = src doc/src
-
-include vsn.mk
-VSN = $(OSE_VSN)
-
-SPECIAL_TARGETS =
-
-#
-# Default Subdir Targets
-#
-include $(ERL_TOP)/make/otp_subdir.mk
diff --git a/lib/ose/doc/html/.gitignore b/lib/ose/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ose/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/ose/doc/man3/.gitignore b/lib/ose/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ose/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/ose/doc/man6/.gitignore b/lib/ose/doc/man6/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ose/doc/man6/.gitignore
+++ /dev/null
diff --git a/lib/ose/doc/pdf/.gitignore b/lib/ose/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ose/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/ose/doc/src/.gitignore b/lib/ose/doc/src/.gitignore
deleted file mode 100644
index 860e9e703e..0000000000
--- a/lib/ose/doc/src/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-ose.xml
diff --git a/lib/ose/doc/src/Makefile b/lib/ose/doc/src/Makefile
deleted file mode 100644
index 7ebd4125ba..0000000000
--- a/lib/ose/doc/src/Makefile
+++ /dev/null
@@ -1,133 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2012. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(OSE_VSN)
-APPLICATION=ose
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Help application directory specification
-# ----------------------------------------------------
-EDOC_DIR = $(ERL_TOP)/lib/edoc
-SYNTAX_TOOLS_DIR = $(ERL_TOP)/lib/syntax_tools
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-
-XML_REF3_FILES = \
- ose.xml \
- ose_erl_driver.xml
-
-XML_REF6_FILES = ose_app.xml
-
-XML_PART_FILES = part.xml
-XML_CHAPTER_FILES = notes.xml ose_intro.xml ose_signals_chapter.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = \
- $(BOOK_FILES) $(XML_CHAPTER_FILES) \
- $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \
- $(XML_APPLICATION_FILES)
-
-# ----------------------------------------------------
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-
-MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
-MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6)
-
-HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
-
-TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
-
-SPECS_FILES =
-
-TOP_SPECS_FILE =
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-XML_FLAGS +=
-
-SPECS_FLAGS = -I../../include -I../../../kernel/include
-
-OSE_SRC_DIR = ../../src
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-docs: man pdf html
-
-$(TOP_PDF_FILE): $(XML_FILES)
-
-pdf: $(TOP_PDF_FILE)
-
-html: $(HTML_REF_MAN_FILE)
-
-man: $(MAN3_FILES) $(MAN6_FILES)
-
-ose.xml: $(OSE_SRC_DIR)/ose.erl
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript\
- $(OSE_SRC_DIR)/$(@:%.xml=%.erl)
-
-debug opt:
-
-clean clean_docs:
- rm -rf $(HTMLDIR)/*
- rm -f $(MAN3DIR)/*
- rm -f $(MAN6DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f $(SPECDIR)/*
- rm -f errs core *~
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_docs_spec: docs
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf"
- $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf"
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/html"
- $(INSTALL_DATA) $(HTMLDIR)/* \
- "$(RELSYSDIR)/doc/html"
- $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3"
- $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
- $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6"
- $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6"
-
-release_spec:
diff --git a/lib/ose/doc/src/book.xml b/lib/ose/doc/src/book.xml
deleted file mode 100644
index d62e0d32f4..0000000000
--- a/lib/ose/doc/src/book.xml
+++ /dev/null
@@ -1,49 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE book SYSTEM "book.dtd">
-
-<book xmlns:xi="http://www.w3.org/2001/XInclude">
- <header titlestyle="normal">
- <copyright>
- <year>2014</year><year>2014</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>OSE</title>
- <prepared>Lukas Larsson</prepared>
- <docno></docno>
- <date>2014-01-08</date>
- <rev>1.0</rev>
- <file>book.xml</file>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>OSE</pagetext>
- <preamble>
- <contents level="2"></contents>
- </preamble>
- <parts>
- <xi:include href="part.xml"/>
- </parts>
- <applications>
- <xi:include href="ref_man.xml"/>
- </applications>
- <releasenotes>
- <xi:include href="notes.xml"/>
- </releasenotes>
- <listofterms></listofterms>
- <index></index>
-</book>
diff --git a/lib/ose/doc/src/notes.xml b/lib/ose/doc/src/notes.xml
deleted file mode 100644
index 06881b6c99..0000000000
--- a/lib/ose/doc/src/notes.xml
+++ /dev/null
@@ -1,109 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2014</year><year>2014</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>OSE Release Notes</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>notes.xml</file>
- </header>
- <p>This document describes the changes made to the OSE application.</p>
-
-<section><title>Ose 1.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Change license text from Erlang Public License to Apache
- Public License v2</p>
- <p>
- Own Id: OTP-12845</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Ose 1.0.2</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Add missing release notes for the OSE application.</p>
- <p>
- Own Id: OTP-12177</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Ose 1.0.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Fix some spelling mistakes in documentation</p>
- <p>
- Own Id: OTP-12152</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Ose 1.0</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Erlang/OTP has been ported to the realtime operating
- system OSE. The port supports both smp and non-smp
- emulator. For details around the port and how to started
- see the User's Guide in the <seealso
- marker="ose:ose_intro">ose</seealso> application. </p>
- <p>
- Note that not all parts of Erlang/OTP has been ported. </p>
- <p>
- Notable things that work are: non-smp and smp emulators,
- OSE signal interaction, crypto, asn1, run_erl/to_erl,
- tcp, epmd, distribution and most if not all non-os
- specific functionality of Erlang.</p>
- <p>
- Notable things that does not work are: udp/sctp, os_mon,
- erl_interface, binding of schedulers.</p>
- <p>
- Own Id: OTP-11334</p>
- </item>
- </list>
- </section>
-
-</section>
-
-</chapter>
diff --git a/lib/ose/doc/src/ose_app.xml b/lib/ose/doc/src/ose_app.xml
deleted file mode 100644
index d555f0ec4f..0000000000
--- a/lib/ose/doc/src/ose_app.xml
+++ /dev/null
@@ -1,38 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE appref SYSTEM "appref.dtd">
-
-<appref>
- <header>
- <copyright>
- <year>2014</year><year>2014</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Enea OSE</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <app>ose</app>
- <appsummary>The OSE Application</appsummary>
- <description>
- <p>The OSE application contains modules and documentation that only
- applies when running Erlang/OTP on Enea OSE.</p>
- </description>
-
-</appref>
diff --git a/lib/ose/doc/src/ose_erl_driver.xml b/lib/ose/doc/src/ose_erl_driver.xml
deleted file mode 100644
index b804c29d2d..0000000000
--- a/lib/ose/doc/src/ose_erl_driver.xml
+++ /dev/null
@@ -1,111 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE cref SYSTEM "cref.dtd">
-
-<cref>
- <header>
- <copyright>
- <year>2013</year><year>2014</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>erl_driver for Enea OSE</title>
- <prepared>Lukas Larsson</prepared>
- <docno></docno>
- <date>2014-01-08</date>
- <rev>A</rev>
- <file>ose_erl_driver.xml</file>
- </header>
- <lib>ose_erl_driver</lib>
- <libsummary>Linked-in drivers in Enea OSE</libsummary>
- <description>
- <p>Writing Linked-in drivers that also work on Enea OSE is very similar for
- how you would do it for Unix. The difference from Unix is that
- driver_select, ready_input and ready_output all work with signals
- instead of file descriptors. This means that the driver_select is
- used to specify which type of signal should trigger calls to
- ready_input/ready_output. The functions described below are available
- to driver programmers on Enea OSE to facilitate this.
- </p>
- </description>
- <section>
- <title>DATA TYPES</title>
-
- <taglist>
- <tag><marker id="union_SIGNAL"/>union SIGNAL</tag>
- <item>See the Enea OSE SPI documentation for a description.</item>
- <tag><marker id="SIGSELECT"/>SIGSELECT</tag>
- <item>See the Enea OSE SPI documentation for a description.</item>
- <tag><marker id="ErlDrvEvent"/>ErlDrvEvent</tag>
- <item>The <c>ErlDrvEvent</c> is a handle to a signal number and id combination. It is passed to <seealso marker="erts:erl_driver#driver_select">driver_select(3)</seealso>.</item>
- <tag><marker id="ErlDrvOseEventId"/>ErlDrvOseEventId</tag>
- <item>This is the id used to associate a specific signal to a
- certain driver instance. </item>
- </taglist>
- </section>
- <funcs>
- <func>
- <name><ret>union SIGNAL *</ret><nametext>erl_drv_ose_get_signal(ErlDrvEvent drv_event)</nametext></name>
- <desc>
- <marker id="erl_drv_ose_get_signal"></marker>
- <p>Fetch the next signal associated with <c>drv_event</c>.
- Signals will be returned in the order which they were received and
- when no more signals are available <c>NULL</c> will be returned.
- Use this function in the ready_input/ready_output callbacks
- to get signals.</p>
- </desc>
- </func>
- <func>
- <name><ret>ErlDrvEvent</ret><nametext>erl_drv_ose_event_alloc(SIGSELECT signo, ErlDrvOseEventId id, ErlDrvOseEventId (*resolve_signal)(union SIGNAL* sig), void *extra)</nametext></name>
- <desc>
- <marker id="erl_drv_ose_event_alloc"></marker>
- <p>Create a new <c>ErlDrvEvent</c> associated with <c>signo</c>,
- <c>id</c> and uses the <c>resolve_signal</c> function to extract
- the <c>id</c> from a signal with <c>signo</c>. The <c>extra</c>
- parameter can be used for additional data. See
- <seealso marker="ose_signals_chapter#driver">
- Signals in a Linked-in driver</seealso> in the OSE User's Guide.
- </p>
- </desc>
- </func>
- <func>
- <name><ret>void</ret><nametext>erl_drv_ose_event_free(ErlDrvEvent drv_event)</nametext></name>
- <desc>
- <marker id="erl_drv_ose_event_free"></marker>
- <p>Free a <c>ErlDrvEvent</c>. This should always be done in the
- <seealso marker="erts:driver_entry#stop_select">stop_select</seealso>
- callback when the event is no longer being used.</p>
- </desc>
- </func>
- <func>
- <name><ret>void</ret><nametext>erl_drv_ose_event_fetch(ErlDrvEvent drv_event, SIGSELECT *signo, ErlDrvOseEventId *id, void **extra)</nametext></name>
- <desc>
- <marker id="erl_drv_ose_event_fetch"></marker>
- <p>Write the signal number, id and any extra data associated with <c>drv_event</c>
- into <c>*signo</c> and <c>*id</c> respectively. <c>NULL</c> can be
- also passed as <c>signo</c> or <c>id</c> in order to ignore that field.
- </p>
- </desc>
- </func>
- </funcs>
- <section>
- <title>SEE ALSO</title>
- <p>
- <seealso marker="erts:driver_entry">driver_entry(3)</seealso>,
- <seealso marker="erts:erl_driver">erl_driver(3)</seealso>
- </p>
- </section>
-</cref>
diff --git a/lib/ose/doc/src/ose_intro.xml b/lib/ose/doc/src/ose_intro.xml
deleted file mode 100644
index 982516c8bd..0000000000
--- a/lib/ose/doc/src/ose_intro.xml
+++ /dev/null
@@ -1,154 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2013</year><year>2014</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Introduction</title>
- <prepared>Lukas Larsson</prepared>
- <docno></docno>
- <date>2014-01-08</date>
- <rev>A</rev>
- <file>ose_intro.xml</file>
- </header>
-
- <section>
- <title>Features</title>
- </section>
-
- <section>
- <title>Starting Erlang/OTP</title>
- <p>
- Starting Erlang/OTP on OSE is not as simple as on Unix/Windows (yet).
- First of all you have to explicitly use the beam (or beam.smp) executables
- found in erts-X.Y.Z/bin as the load module that you run. This in turn
- means that you have to supply the raw beam arguments to the emulator
- when starting. Fortunately <c>erl</c> on Unix/Windows has a
- undocumented flag called <c>-emu_args_exit</c> that can be used to
- figure out what the arguments to beam look like. For example:</p>
- <code># erl +Mut false +A 10 +S 4:4 +Muycs256 +P 2096 +Q 2096 -emu_args_exit
--Mut
-false
--A
-10
--S
-4:4
--Muycs256
--P
-2096
--Q
-2096
---
--root
-/usr/local/lib/erlang
--progname
-erl
---
--home
-/home/erlang
---</code>
- <p>
- The arguments are printed on separate lines to make it possible to know
- what has to be quoted with &quot;. Each line is one quotable unit.
- So taking the arguments above you can supply them to pm_create or
- just execute directly on the command line. For example:</p>
- <code>rtose@acp3400> pm_install erlang /mst/erlang/erts-6.0/bin/beam.smp
-rtose@acp3400> pm_create -c ARGV="-Mut false -A 10 -S 4:4 -Muycs256 -P 2096 -Q 2099 -- -root /mst/erlang -progname erl -- -home /mst/erlang --" erlang
-pid: 0x110059
-rtose@acp3400> pm_start 0x110059</code>
- <p>
- Also note that since we are running erl to figure out the arguments on a
- separate machine the paths have to be updated. In the example above
- <c>/usr/local/lib/erlang</c> was replaced by <c>/mst/erlang/</c>. The
- goal is to in future releases not have to do the special argument handling
- but for now (OTP 17.0) you have to do it.
- </p>
- <note>
- Because of a limitation in the way the OSE handles stdio when starting
- load modules using pm_install/create the Erlang shell only reads every
- other command from stdin. However if you start Erlang using run_erl
- you do not have this problem. So it is highly recommended that you
- start Erlang using run_erl.
- </note>
- </section>
-
- <section>
- <title>run_erl and to_erl</title>
- <p>
- In OSE run_erl and to_erl are combined into a single load module called
- run_erl_lm. Installing and starting the load module will add two new
- shell commands called run_erl and to_erl. They work in exactly the same
- way as the unix variants of run_erl and to_erl, except that the read
- and write pipes have to be placed under the /pipe vm. One additional
- option also exists to run_erl on ose:
- <taglist>
- <tag><c>-block Name</c></tag>
- <item>The name of the install handle and block that will be created/used by
- installing and exectuting the first part of the command. If nothing
- if given the basename of the load module will be used for this value.
- Example:
- <code>pm_install erlang /path/to/erlang/vm/beam.smp
-run_erl -daemon -block erlang /pipe/ /mst/erlang_logs/ "beam.smp -A 1 -- -root /mst/erlang -- -home /mst --"</code>
- </item>
- </taglist>
- The same argument munching as when starting Erlang/OTP without run_erl
- has to be done. If <c>-daemon</c> is given then all error printouts
- are sent to the ramlog.
- See also
- <seealso marker="erts:run_erl">run_erl</seealso> for more details.
- </p>
- <p>
- Below is an example of how to get started with <c>run_erl_lm</c>.
- <code>rtose@acp3400> pm_install run_erl_lm /mst/erlang/erts-6.0/bin/run_erl_lm
-rtose@acp3400> pm_create run_erl_lm
-pid: 0x1c005d
-rtose@acp3400> pm_start 0x1c005d
-rtose@acp3400> mkdir /mst/erlang_log
-rtose@acp3400> run_erl -daemon /pipe/ /mst/erlang_log/ "/mst/erlang/erts-6.0/bin/beam.smp -A 1 -- -root /mst/erlang -- -home /mst --"
-rtose@acp3400> to_erl
-Attaching to /pipe/erlang.pipe.1 (^C to exit)
-os:type().
-{ose,release}
-2>
-'to_erl' terminated.</code>
- Note that Ctrl-C is used instead of Ctrl-D to exit the to_erl shell.
- </p>
- </section>
-
- <section>
- <title>epmd</title>
- <p>
- In OSE epmd will not be started automatically so if you want to use
- Erlang distribution you have to manually start epmd.
- </p>
- </section>
-
- <section>
- <title>VM Process Priorities</title>
- <p>
- It is possible to set the priorities you want for the OSE processes that
- thr emulator creates in the lmconf. An example of how to do it can be
- found in the default lmconf file in
- $ERL_TOP/erts/emulator/sys/ose/beam.lmconf.
- </p>
- </section>
-
-</chapter>
diff --git a/lib/ose/doc/src/ose_signals_chapter.xml b/lib/ose/doc/src/ose_signals_chapter.xml
deleted file mode 100644
index bcf2259577..0000000000
--- a/lib/ose/doc/src/ose_signals_chapter.xml
+++ /dev/null
@@ -1,240 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2013</year><year>2014</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Interacting with Enea OSE</title>
- <prepared>Lukas Larsson</prepared>
- <docno></docno>
- <date>2014-01-08</date>
- <rev>A</rev>
- <file>ose_signals_chapter.xml</file>
- </header>
-
- <marker id="introduction"></marker>
- <section>
- <title>Introduction</title>
- <p>The main way which programs on Enea OSE interact is through the
- usage of message passing, much the same way as Erlang processes
- communicate. There are two ways in which an Erlang programmer can
- interact with the signals sent from other Enea OSE processes; either
- through the provided <c>ose</c> module, or by writing a custom linked-in
- driver. This User's Guide describes and provides examples for both
- approaches.
- </p>
- </section>
-
- <marker id="erlang"></marker>
- <section>
- <title>Signals in Erlang</title>
- <p>Erlang/OTP on OSE provides a erlang module called
- <seealso marker="ose:ose">ose</seealso> that can be used to interact
- with other OSE processes using message passing. The api in the module
- is very similar to the native OSE api, so for details of how the
- functions work please refer to the official OSE documenation. Below
- is an example usage of the API.
- </p>
- <code>1> P1 = ose:open("p1").
-#Port&gt;0.344>
-2> ose:hunt(P1,"p2").
-{#Port&gt;0.344>,1}
-3> P2 = ose:open("p2").
-#Port&gt;0.355>
-4> flush().
-Shell got {mailbox_up,#Port&gt;0.344>,{#Port&gt;0.344>,1},852189}
-ok
-5> ose:listen(P1,[1234]).
-ok
-6> ose:send(P2,ose:get_id(P1),1234,&gt;&gt;"hello">>).
-ok
-7> flush().
-Shell got {message,#Port&gt;0.344>,{852189,1245316,1234,&gt;&gt;"hello">>}}
-ok</code>
- </section>
-
- <marker id="driver"></marker>
- <section>
- <title>Signals in a Linked-in driver</title>
- <p>
- Writing Linked-in drivers for OSE is very similar to how it is done
- for Unix/Windows. It is only the way in which the driver subscribes
- and consumed external events that is different. In Unix (and Windows)
- file descriptiors (and Event Objects) are used to select on. On OSE
- we use signals to deliver the same functionality. There are two large
- differences between a signal and an fd.
- </p>
- <p>
- In OSE it is not possible for a signal number to be a unique identifier
- for a resource in the same way as an fd is. For example; let's say we
- implement a driver that does an asynchronous hunt that uses signal
- number 1234 as the hunt_sig. If we want to be able to have multiple
- hunt ports running at the same time we have to have someway of routing
- the signal to the correct port. This is achieved by supplying a secondary
- id that can be retrieved through the meta-data or payload of the signal,
- e.g:
- <code>ErlDrvEvent event = erl_drv_ose_event_alloc(1234,port,resolver);</code>
- The event you get back from
- <seealso marker="ose_erl_driver#erl_drv_ose_event_alloc">
- erl_drv_ose_event_alloc</seealso> can then be used by
- <seealso marker="erts:erl_driver#driver_select">driver_select</seealso>
- to subscribe to signals. The first argument is just the signal number
- that we are interested in. The second is the id that we choose to use,
- in this case the port id that we got in the
- <seealso marker="erts:driver_entry#start">start</seealso> callback is
- used. The third argument is a function pointer to a function that can
- be used to figure out the id from a given signal. The fourth argument can
- point to any additional data you might want to associate with the event.
- There is a complete. You can examine the data contained in the event with
- <seealso marker="ose_erl_driver#erl_drv_ose_event_fetch">erl_drv_ose_event_fetch</seealso>
- , eg:
- <code>erl_drv_ose_event_fetch(event, &amp;signal, &amp;port, (void **)&amp;extra);</code>
- example of what this could look like in
- <seealso marker="#example">the next section</seealso>.
- <note>It is very important to issue the driver_select call before
- any of the signals you are interested in are sent. If driver_select
- is called after the signal is sent, there is a high probability that it
- will be lost.</note>
- </p>
- <p>
- The other difference from unix is that in OSE the payload of the event
- (i.e. the signal data) is already received when the ready_output/input
- callbacks are called. This means that you access the data of a signal
- by calling <seealso marker="ose_erl_driver#erl_drv_ose_get_signal">
- erl_drv_ose_get_signal</seealso>. Additionally multiple signals might be
- associated with the event, so you should call
- <seealso marker="ose_erl_driver#erl_drv_ose_get_signal">
- erl_drv_ose_get_signal</seealso> until <c>NULL</c> is returned.
- </p>
- </section>
-
- <marker id="example"></marker>
- <section>
- <title>Example Linked-in driver</title>
-<code>#include "erl_driver.h"
-#include "ose.h"
-
-struct huntsig {
- SIGSELECT signo;
- ErlDrvPort port;
-};
-
-union SIGNAL {
- SIGSELECT signo;
- struct huntsig;
-}
-
-/* Here we have to get the id from the signal. In this case we use the
- port id since we have control over the data structure of the signal.
- It is however possible to use anything in here. The only restriction
- is that the same id has to be used for all signals of the same number.*/
-ErlDrvOseEventId resolver(union SIGNAL *sig) {
- return (ErlDrvOseEventId)sig->huntsig.port;
-}
-
-static int drv_init(void) { return 0; };
-
-static ErlDrvData drv_start(ErlDrvPort port, char *command) {
- return (ErlDrvData)port;
-}
-
-static ErlDrvSSizeT control(ErlDrvData driver_data, unsigned int cmd,
- char *buf, ErlDrvSizeT len,
- char **rbuf, ErlDrvSizeT rlen) {
- ErlDrvPort port = (ErlDrvPort)driver_data;
-
- /* An example of extra data to associate with the event */
- char *extra_data = driver_alloc(80);
- snprintf("extra_data, "Event, sig_no: 1234, and port: %d", port);
-
- /* Create a new event to select on */
- ErlDrvOseEvent evt = erl_drv_ose_event_alloc(1234,port,resolver, extra_data);
-
- /* Make sure to do the select call _BEFORE_ the signal arrives.
- The signal might get lost if the hunt call is done before the
- select. */
- driver_select(port,evt,ERL_DRV_READ|ERL_DRV_USE,1);
-
- union SIGNAL *sig = alloc(sizeof(union SIGNAL),1234);
- sig->huntsig.port = port;
- hunt("testprocess",0,NULL,&amp;sig);
- return 0;
-}
-
-static void ready_input(ErlDrvData driver_data, ErlDrvEvent evt) {
- char *extra_data;
- /* Get the first signal payload from the event */
- union SIGNAL *sig = erl_drv_ose_get_signal(evt);
- ErlDrvPort port = (ErlDrvPort)driver_data;
- while (sig != NULL) {
- if (sig->signo == 1234) {
- /* Print out the string we added as the extra parameter */
- erl_drv_ose_event_fetch(evt, NULL, NULL, (void **)&amp;extra_data);
- printf("We've received: %s\n", extra_data);
-
- /* If it is our signal we send a message with the sender of the signal
- to the controlling erlang process */
- ErlDrvTermData reply[] = { ERL_DRV_UINT, (ErlDrvUInt)sender(&amp;sig) };
- erl_drv_send_term(port,reply,sizeof(reply) / sizeof(reply[0]));
- }
-
- /* Cleanup the signal and deselect on the event.
- Note that the event itself has to be free'd in the stop_select
- callback. */
- free_buf(&amp;sig);
- driver_select(port,evt,ERL_DRV_READ|ERL_DRV_USE,0);
-
- /* There could be more than one signal waiting in this event, so
- we have to loop until sig == NULL */
- sig = erl_drv_ose_get_signal(evt);
- }
-}
-
-static void stop_select(ErlDrvEvent event, void *reserved)
-{
- /* Free the extra_data */
- erl_drv_ose_event_fetch(evt, NULL, NULL, (void **)&amp;extra_data);
- driver_free(extra_data);
-
- /* Free the event itself */
- 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,
- .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
-};
-</code>
- </section>
-
-</chapter>
diff --git a/lib/ose/doc/src/part.xml b/lib/ose/doc/src/part.xml
deleted file mode 100644
index 0c9ebd16c0..0000000000
--- a/lib/ose/doc/src/part.xml
+++ /dev/null
@@ -1,39 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>2014</year>
- <year>2014</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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.
- </legalnotice>
-
- <title>OSE User's Guide</title>
- <prepared>Lukas Larsson</prepared>
- <docno></docno>
- <date>2014-01-08</date>
- <rev>1.0</rev>
- <file>part.xml</file>
- </header>
- <description>
- <p><em>OSE</em>.</p>
- </description>
- <xi:include href="ose_intro.xml"/>
- <xi:include href="ose_signals_chapter.xml"/>
-</part>
diff --git a/lib/ose/doc/src/ref_man.xml b/lib/ose/doc/src/ref_man.xml
deleted file mode 100644
index 964e5ab8ff..0000000000
--- a/lib/ose/doc/src/ref_man.xml
+++ /dev/null
@@ -1,40 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE application SYSTEM "application.dtd">
-
-<application xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>2014</year><year>2014</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>OSE Reference Manual</title>
- <prepared>Lukas Larsson</prepared>
- <docno></docno>
- <date>2014-01-08</date>
- <rev>1.0</rev>
- <file>ref_man.xml</file>
- </header>
- <description>
- <p>The Standard Erlang Libraries application, <em>STDLIB</em>,
- contains modules for manipulating lists, strings and files etc.</p>
- <br></br>
- </description>
- <xi:include href="ose_app.xml"/>
- <xi:include href="ose.xml"/>
- <xi:include href="ose_erl_driver.xml"/>
-</application>
diff --git a/lib/ose/ebin/.gitignore b/lib/ose/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ose/ebin/.gitignore
+++ /dev/null
diff --git a/lib/ose/include/.gitignore b/lib/ose/include/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ose/include/.gitignore
+++ /dev/null
diff --git a/lib/ose/info b/lib/ose/info
deleted file mode 100644
index 85c07dbe82..0000000000
--- a/lib/ose/info
+++ /dev/null
@@ -1,2 +0,0 @@
-group: misc Miscellaneous Applications
-short: Description of Enea OSE specific functionality
diff --git a/lib/ose/src/Makefile b/lib/ose/src/Makefile
deleted file mode 100644
index a89e9392e9..0000000000
--- a/lib/ose/src/Makefile
+++ /dev/null
@@ -1,107 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2013. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(OSE_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/ose-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-MODULES= \
- ose
-
-HRL_FILES=
-
-INTERNAL_HRL_FILES=
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET)
-
-APP_FILE= ose.app
-
-APP_SRC= $(APP_FILE).src
-APP_TARGET= $(EBIN)/$(APP_FILE)
-
-APPUP_FILE= ose.appup
-
-APPUP_SRC= $(APPUP_FILE).src
-APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-
-ifeq ($(NATIVE_LIBS_ENABLED),yes)
-ERL_COMPILE_FLAGS += +native
-endif
-ERL_COMPILE_FLAGS += -I../include -I../../kernel/include -Werror
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-debug opt: $(TARGET_FILES)
-
-clean:
- rm -f $(TARGET_FILES)
- rm -f core
- rm -f erl_parse.erl
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-
-$(APP_TARGET): $(APP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin"
-
-release_docs_spec:
-
-# ----------------------------------------------------
-# Dependencies -- alphabetically, please
-# ----------------------------------------------------
diff --git a/lib/ose/src/ose.app.src b/lib/ose/src/ose.app.src
deleted file mode 100644
index 036779eb16..0000000000
--- a/lib/ose/src/ose.app.src
+++ /dev/null
@@ -1,28 +0,0 @@
-%% This is an -*- erlang -*- file.
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-{application, ose,
- [{description, "Enea OSE specific modules"},
- {vsn, "%VSN%"},
- {modules, [ose]},
- {registered,[]},
- {applications, [stdlib,kernel]},
- {env, []},
- {runtime_dependencies, ["stdlib-2.0","erts-6.0"]}]}.
diff --git a/lib/ose/src/ose.appup.src b/lib/ose/src/ose.appup.src
deleted file mode 100644
index 28b6da3439..0000000000
--- a/lib/ose/src/ose.appup.src
+++ /dev/null
@@ -1,23 +0,0 @@
-%% -*- erlang -*-
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-{"%VSN%",
- [
- ],
- [
- ]}.
diff --git a/lib/ose/src/ose.erl b/lib/ose/src/ose.erl
deleted file mode 100644
index 5534dba4d4..0000000000
--- a/lib/ose/src/ose.erl
+++ /dev/null
@@ -1,453 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% @doc Interface module for OSE messaging and process monitoring from Erlang
-%%
-%% For each mailbox created through {@link open/1} a OSE phantom process with
-%% that name is started. Since phantom processes are used the memory footprint
-%% of each mailbox is quite small.
-%%
-%% To receive messages you first have to subscribe to the specific message
-%% numbers that you are interested in with {@link listen/2}. The messages
-%% will be sent to the Erlang process that created the mailbox.
-%%
-%% @end
-%%
--module(ose).
-
-%%==============================================================================
-%% Exported API
-%%==============================================================================
--export([open/1,
- close/1,
- get_id/1,
- get_name/2,
- hunt/2,
- dehunt/2,
- attach/2,
- detach/2,
- send/4,
- send/5,
- listen/2
- ]).
-
-%%==============================================================================
-%% Types
-%%==============================================================================
--opaque mailbox() :: port().
-%% Mailbox handle. Implemented as an erlang port.
-
--opaque mailbox_id() :: integer().
-%% Mailbox ID, this is the same as the process id of an OSE process.
-%% An integer.
-
--type message_number() :: 0..4294967295.
-%% OSE Signal number
-
--opaque hunt_ref() :: {mailbox(),integer()}.
-%% Reference from a hunt request. This term will be included
-%% in a successful hunt response.
-
--opaque attach_ref() :: {mailbox(),integer()}.
-%% Reference from an attach request. This term will be included
-%% in the term returned when the attached mailbox disappears.
-
--export_type([mailbox_id/0,
- message_number/0,
- mailbox/0,
- hunt_ref/0,
- attach_ref/0]).
-
-%%==============================================================================
-%% Defines
-%%==============================================================================
--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(INT_32BIT(Int),(is_integer(Int) andalso (Int >= 0) andalso (Int < (1 bsl 32)))).
-
-%%==============================================================================
-%% API functions
-%%==============================================================================
-
-%%------------------------------------------------------------------------------
-%% @doc Create a mailbox with the given name and return a port that handles
-%% the mailbox.
-%%
-%% An OSE phantom process with the given name will be created that will send any
-%% messages sent through this mailbox. Any messages sent to the new OSE process
-%% will automatically be converted to an Erlang message and sent to the Erlang
-%% process that calls this function. See {@link listen/2} for details about the
-%% format of the message sent.
-%%
-%% The caller gets linked to the created mailbox.
-%%
-%% raises: `badarg' | `system_limit'
-%%
-%% @see listen/2
-%% @end
-%%------------------------------------------------------------------------------
--spec open(Name) -> Port when
- Name :: iodata(),
- Port :: mailbox().
-open(Name) ->
- try open_port({spawn_driver,?DRIVER_NAME}, [binary]) of
- Port ->
- try port_command(Port,[?OPEN,Name]) of
- true ->
- receive
- {ose_drv_reply,Port,{error,Error}} ->
- close(Port),
- erlang:error(Error,[Name]);
- {ose_drv_reply,Port,ok} ->
- Port
- end
- catch
- error:badarg -> close(Port),erlang:error(badarg,[Name])
- end
- catch
- error:badarg -> erlang:error(badarg,[Name])
- end.
-
-%%------------------------------------------------------------------------------
-%% @doc Close a mailbox
-%%
-%% This kills the OSE phantom process associated with this mailbox.
-%%
-%% Will also consume any ``{'EXIT',Port,_}'' message from the port that comes
-%% due to the port closing when the calling process traps exits.
-%%
-%% raises: `badarg'
-%% @end
-%%------------------------------------------------------------------------------
--spec close(Port) -> ok when
- Port :: mailbox().
-close(Port) when is_port(Port) ->
- %% Copied from prim_inet
- case erlang:process_info(self(), trap_exit) of
- {trap_exit,true} ->
- link(Port),
- catch erlang:port_close(Port),
- receive {'EXIT',Port,_} -> ok end;
- {trap_exit,false} ->
- catch erlang:port_close(Port),
- ok
- end;
-close(NotPort) ->
- erlang:error(badarg,[NotPort]).
-
-%%------------------------------------------------------------------------------
-%% @doc Get the mailbox id for the given port.
-%%
-%% The mailbox id is the same as the OSE process id of the OSE phantom process
-%% that this mailbox represents.
-%%
-%% raises: `badarg'
-%% @end
-%%------------------------------------------------------------------------------
--spec get_id(Port) -> Pid when
- Port :: mailbox(),
- Pid :: mailbox_id().
-get_id(Port) ->
- try port_control(Port, ?GET_SPID, <<>>) of
- <<Spid:32>> -> Spid
- catch error:_Error ->
- erlang:error(badarg,[Port])
- end.
-
-%%------------------------------------------------------------------------------
-%% @doc Get the mailbox name for the given mailbox id.
-%%
-%% The mailbox name is the name of the OSE process with process id Pid.
-%%
-%% This call will fail with badarg if the underlying system does not support
-%% getting the name from a process id.
-%%
-%% raises: `badarg'
-%% @end
-%%------------------------------------------------------------------------------
--spec get_name(Port, Pid) -> Name | undefined when
- Port :: mailbox(),
- Pid :: mailbox_id(),
- Name :: binary().
-get_name(Port, Pid) when ?INT_32BIT(Pid) ->
- try port_control(Port, ?GET_NAME, <<Pid:32>>) of
- [] -> undefined;
- Res -> Res
- catch error:_Error ->
- erlang:error(badarg,[Port,Pid])
- end;
-get_name(Port, Pid) ->
- erlang:error(badarg,[Port,Pid]).
-
-
-%%------------------------------------------------------------------------------
-%% @doc Hunt for OSE process by name.
-%%
-%% Will send `{mailbox_up, Port, Ref, MboxId}'
-%% to the calling process when the OSE process becomes available.
-%%
-%% Returns a reference term that can be used to cancel the hunt
-%% using {@link dehunt/2}.
-%%
-%% raises: `badarg'
-%%
-%% @end
-%%------------------------------------------------------------------------------
--spec hunt(Port, HuntPath) -> Ref when
- Port :: mailbox(),
- HuntPath :: iodata(),
- Ref :: hunt_ref().
-hunt(Port, HuntPath) ->
- try port_command(Port, [?HUNT,HuntPath]) of
- true ->
- receive
- {ose_drv_reply,Port,{error,Error}} ->
- erlang:error(Error,[Port,HuntPath]);
- {ose_drv_reply,Port,Ref} ->
- Ref
- end
- catch error:_Error ->
- erlang:error(badarg,[Port,HuntPath])
- end.
-
-%%------------------------------------------------------------------------------
-%% @doc Stop hunting for OSE process.
-%%
-%% If a message for this hunt has been sent but not received
-%% by the calling process, it is removed from the message queue.
-%% Note that this only works if the same process that did
-%% the hunt does the dehunt.
-%%
-%% raises: `badarg'
-%%
-%% @see hunt/2
-%% @end
-%%------------------------------------------------------------------------------
--spec dehunt(Port, Ref) -> ok when
- Port :: mailbox(),
- Ref :: hunt_ref().
-dehunt(Port, {Port,Ref}) when ?INT_32BIT(Ref) ->
- try port_command(Port, <<?DEHUNT:8, Ref:32>>) of
- true ->
- receive
- {ose_drv_reply,Port,{error,enoent}} ->
- %% enoent could mean that it is in the message queue
- receive
- {mailbox_up, Port, {Port,Ref}, _} ->
- ok
- after 0 ->
- ok
- end;
- {ose_drv_reply,Port,ok} ->
- ok
- end
- catch error:_Error ->
- erlang:error(badarg,[Port,{Port,Ref}])
- end;
-dehunt(Port,Ref) ->
- erlang:error(badarg,[Port,Ref]).
-
-%%------------------------------------------------------------------------------
-%% @doc Attach to an OSE process.
-%%
-%% Will send `{mailbox_down, Port, Ref, MboxId}'
-%% to the calling process if the OSE process exits.
-%%
-%% Returns a reference that can be used to cancel the attachment
-%% using {@link detach/2}.
-%%
-%% raises: `badarg' | `enomem'
-%%
-%% @end
-%%------------------------------------------------------------------------------
--spec attach(Port,Pid) -> Ref when
- Port :: mailbox(),
- Pid :: mailbox_id(),
- Ref :: attach_ref().
-attach(Port, Spid) when ?INT_32BIT(Spid) ->
- try port_command(Port, <<?ATTACH:8, Spid:32>>) of
- true ->
- receive
- {ose_drv_reply,Port,{error,Error}} ->
- erlang:error(Error,[Port,Spid]);
- {ose_drv_reply,Port,Ref} ->
- Ref
- end
- catch error:_Error ->
- erlang:error(badarg,[Port,Spid])
- end;
-attach(Port,Spid) ->
- erlang:error(badarg,[Port,Spid]).
-
-
-%%------------------------------------------------------------------------------
-%% @doc Remove attachment to an OSE process.
-%%
-%% If a message for this monitor has been sent but not received
-%% by the calling process, it is removed from the message queue.
-%% Note that this only works of the same process
-%% that did the attach does the detach.
-%%
-%% raises: `badarg'
-%%
-%% @see attach/2
-%% @end
-%%------------------------------------------------------------------------------
--spec detach(Port,Ref) -> ok when
- Port :: mailbox(),
- Ref :: attach_ref().
-detach(Port, {Port,Ref} ) when ?INT_32BIT(Ref) ->
- try port_command(Port, <<?DETACH:8, Ref:32>>) of
- true ->
- receive
- {ose_drv_reply,Port,{error,enoent}} ->
- %% enoent could mean that it is in the message queue
- receive
- {mailbox_down,Port,{Port,Ref},_} ->
- ok
- after 0 ->
- ok
- end;
- {ose_drv_reply,Port,ok} ->
- ok
- end
- catch error:_Error ->
- erlang:error(badarg,[Port,{Port,Ref}])
- end;
-detach(Port,Ref) ->
- erlang:error(badarg,[Port,Ref]).
-
-%%------------------------------------------------------------------------------
-%% @doc Send an OSE message.
-%%
-%% The message is sent from the OSE process' own ID that is: `get_id(Port)'.
-%%
-%% raises: `badarg'
-%%
-%% @see send/5
-%% @end
-%%------------------------------------------------------------------------------
--spec send(Port,Pid,SigNo,SigData) -> ok when
- Port :: mailbox(),
- Pid :: mailbox_id(),
- SigNo :: message_number(),
- SigData :: iodata().
-send(Port, Spid, SigNo, SigData) when ?INT_32BIT(Spid), ?INT_32BIT(SigNo) ->
- try erlang:port_command(Port, [<<?SEND:8, Spid:32, SigNo:32>>, SigData]) of
- true -> ok
- catch error:_Error ->
- erlang:error(badarg,[Port,Spid,SigNo,SigData])
- end;
-send(Port,Spid,SigNo,SigData) ->
- erlang:error(badarg,[Port,Spid,SigNo,SigData]).
-
-
-%%------------------------------------------------------------------------------
-%% @doc Send an OSE message with different sender.
-%%
-%% As {@link send/4} but the sender will be `SenderPid'.
-%%
-%% raises: `badarg'
-%%
-%% @see send/4
-%% @end
-%%------------------------------------------------------------------------------
--spec send(Port,Pid,SenderPid,SigNo,SigData) -> ok when
- Port :: mailbox(),
- Pid :: mailbox_id(),
- SenderPid :: mailbox_id(),
- SigNo :: message_number(),
- SigData :: iodata().
-send(Port, Spid, SenderPid, SigNo, SigData)
- when ?INT_32BIT(Spid), ?INT_32BIT(SenderPid), ?INT_32BIT(SigNo) ->
- try erlang:port_command(Port, [<<?SEND_W_S:8, Spid:32, SenderPid:32,
- SigNo:32>>, SigData]) of
- true -> ok
- catch error:_Error ->
- erlang:error(badarg,[Port,Spid,SenderPid,SigNo,SigData])
- end;
-send(Port,Spid,SenderPid,SigNo,SigData) ->
- erlang:error(badarg,[Port,Spid,SenderPid,SigNo,SigData]).
-
-%%------------------------------------------------------------------------------
-%% @doc Start listening for specified OSE signal numbers.
-%%
-%% The mailbox will send `{message,Port,{FromMboxId,ToMboxId,MsgNo,MsgData}}'
-%% to the process that created the mailbox when an OSE message with any
-%% of the specified `SigNos' arrives.
-%%
-%% Repeated calls to listen will replace the current set of signal numbers to
-%% listen to. i.e
-%%
-%% ```1>ose:listen(MsgB,[1234,12345]).
-%% ok
-%% 2> ose:listen(MsgB,[1234,123456]).
-%% ok.'''
-%%
-%% The above will first listen for signals with numbers 1234 and 12345, and then
-%% replace that with only listening to 1234 and 123456.
-%%
-%% With the current implementation it is not possible to listen to all signal
-%% numbers.
-%%
-%% raises: `badarg' | `enomem'
-%%
-%% @end
-%%------------------------------------------------------------------------------
--spec listen(Port, SigNos) -> ok when
- Port :: mailbox(),
- SigNos :: list(message_number()).
-listen(Port, SigNos) when is_list(SigNos) ->
- USSigNos = lists:usort(SigNos),
- BinSigNos = try
- << <<SigNo:32>> ||
- SigNo <- USSigNos,
- ?INT_32BIT(SigNo) orelse erlang:error(badarg)
- >>
- catch _:_ ->
- erlang:error(badarg,[Port,SigNos])
- end,
- try port_command(Port, [?LISTEN, BinSigNos]) of
- true ->
- receive
- {ose_drv_reply,Port,{error,Error}} ->
- erlang:error(Error,[Port,SigNos]);
- {ose_drv_reply,Port,Else} ->
- Else
- end
- catch error:_Error ->
- erlang:error(badarg,[Port,SigNos])
- end;
-listen(Port, SigNos) ->
- erlang:error(badarg,[Port,SigNos]).
-
-
-%%%=============================================================================
-%%% Internal functions
-%%%=============================================================================
diff --git a/lib/ose/test/Makefile b/lib/ose/test/Makefile
deleted file mode 100644
index 7e2080ba38..0000000000
--- a/lib/ose/test/Makefile
+++ /dev/null
@@ -1,67 +0,0 @@
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= \
- ose_SUITE
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-INSTALL_PROGS= $(TARGET_FILES)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/ose_test
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-
-ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \
- -I$(ERL_TOP)/lib/kernel/include
-
-EBIN = .
-
-EMAKEFILE=Emakefile
-COVERFILE=ose.cover
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-make_emakefile:
- $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \
- > $(EMAKEFILE)
-
-tests debug opt: make_emakefile
- erl $(ERL_MAKE_FLAGS) -make
-
-clean:
- rm -f $(EMAKEFILE)
- rm -f $(TARGET_FILES)
- rm -f core
-
-docs:
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
-
-release_tests_spec: make_emakefile
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) ose.spec $(EMAKEFILE) \
- $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)"
- chmod -R u+w "$(RELSYSDIR)"
- @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
-
-release_docs_spec:
diff --git a/lib/ose/test/ose.cover b/lib/ose/test/ose.cover
deleted file mode 100644
index 7b846cfaf6..0000000000
--- a/lib/ose/test/ose.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-%% -*- erlang -*-
-{incl_app,ose,details}.
diff --git a/lib/ose/test/ose.spec b/lib/ose/test/ose.spec
deleted file mode 100644
index c897e8cd16..0000000000
--- a/lib/ose/test/ose.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../ose_test",all}.
diff --git a/lib/ose/test/ose_SUITE.erl b/lib/ose/test/ose_SUITE.erl
deleted file mode 100644
index 31d950bd03..0000000000
--- a/lib/ose/test/ose_SUITE.erl
+++ /dev/null
@@ -1,766 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(ose_SUITE).
-
-%-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([
- basic/1,stress/1,multi_msg_numbers/1,multi_mailboxes/1,
- hunt/1,multi_hunt/1,dehunt/1,multi_dehunt/1,
- attach/1,multi_attach/1,detach/1,multi_detach/1,
- open_errors/1,close_errors/1,get_id_errors/1,get_name_errors/1,
- hunt_errors/1,dehunt_errors/1,attach_errors/1,detach_errors/1,
- send_errors/1,send_w_s_errors/1,listen_errors/1
- ]).
-
--define(INTERFACE,ose).
-
-
-init_per_testcase(_Func, Config) ->
- Config.
-end_per_testcase(_Func, _Config) ->
- ok.
-
-suite() -> [{timeout,{30,seconds}}].
-
-all() ->
- [
- basic,stress,multi_msg_numbers,multi_mailboxes,
- hunt,multi_hunt,dehunt,multi_dehunt,
- attach,multi_attach,detach,multi_detach,
-
- open_errors,close_errors,get_id_errors,get_name_errors,
- hunt_errors,dehunt_errors,attach_errors,detach_errors,
- send_errors,send_w_s_errors,listen_errors
- ].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- case os:type() of
- {ose,_} ->
- Config;
- _Else ->
- {skip,"Only run on OSE"}
- end.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-basic(_Config) ->
-
- [P1,P2] = multi_open(2,[42]),
- P1Id = ?INTERFACE:get_id(P1),
- P2Id = ?INTERFACE:get_id(P2),
-
- ok = ?INTERFACE:send(P2,P1Id,42,<<"ping">>),
- receive
- {message,P1,V1} ->
- {P2Id,P1Id,42,<<"ping">>} = V1,
- ?INTERFACE:send(P1,P2Id,42,<<"pong">>);
- Else1 ->
- ct:fail({got_wrong_message,Else1})
- end,
-
- receive
- {message,P2,V2} ->
- {P1Id,P2Id,42,<<"pong">>} = V2;
- Else2 ->
- ct:fail({got_wrong_message,Else2})
- end,
-
- ?INTERFACE:close(P1),
- ?INTERFACE:close(P2).
-
-%% Send 1000 messages and see if we can cope and that msg order is preserved
-stress(_Config) ->
-
- Iterations = 1000,
-
- [P1,P2] = multi_open(2,[42]),
- P1Id = ?INTERFACE:get_id(P1),
- P2Id = ?INTERFACE:get_id(P2),
-
- spawn(fun() ->
- n(fun(N) ->
- Msg = [<<"ping">>|integer_to_list(N)],
- ?INTERFACE:send(P2,P1Id,42,Msg)
- end,Iterations)
- end),
- timer:sleep(100),
- n(fun(N) ->
- receive
- {message,P1,Value} ->
- Int = integer_to_binary(N),
- {P2Id,P1Id,42,<<"ping",Int/binary>>} = Value,
- ok;
- Else ->
- ct:fail({got_wrong_message,Else})
- end
- end,Iterations),
-
- ?INTERFACE:close(P1),
- ?INTERFACE:close(P2).
-
-%% Listen to 1000 different message numbers and send some random messages
-multi_msg_numbers(_Config) ->
-
- Iterations = 100,
-
- [P1,P2] = multi_open(2,lists:seq(2000,3000)),
- P1Id = ?INTERFACE:get_id(P1),
-
- n(fun(_) ->
- Num = random:uniform(1000)+2000,
- ?INTERFACE:send(P2,P1Id,Num,<<"ping",(integer_to_binary(Num))/binary>>)
- end,Iterations),
-
- n(fun(_) ->
- receive
- {message,P1,{_,_,Id,<<"ping",Num/binary>>}} when Id > 2000;
- Id =< 3000 ->
- Id = binary_to_integer(Num),
- ok;
- Else ->
- ct:fail({got_wrong_message,Else})
- end
- end,Iterations),
-
- ?INTERFACE:close(P1),
- ?INTERFACE:close(P2).
-
-
-%% Create 100 mailboxes and send messages to them
-multi_mailboxes(_Config) ->
-
- Mailboxes = 100,
-
- [P1|MBs] = multi_open(Mailboxes,[42]),
-
- [?INTERFACE:send(P1,?INTERFACE:get_id(P),42,[<<"ping">>,?INTERFACE:get_name(P,?INTERFACE:get_id(P))]) || P <- MBs],
-
- [receive
- {message,P,Value} ->
- Name = ?INTERFACE:get_name(P,?INTERFACE:get_id(P)),
- {_,_,42,<<"ping",Name/binary>>} = Value,
- ok
- end || P <- MBs],
-
- [?INTERFACE:close(P) || P <- [P1|MBs]],
- ok.
-
-hunt(_Config) ->
- [P1,P2] = multi_open(2,[]),
-
- Ref = ?INTERFACE:hunt(P1,"p2"),
- receive
- {mailbox_up,P1,Ref,Pid} ->
- Pid = ?INTERFACE:get_id(P2),
- ?INTERFACE:close(P1),
- ?INTERFACE:close(P2);
- Else ->
- ct:fail({got_wrong_message,Else,Ref})
- end.
-
-multi_hunt(_Config) ->
-
- Iterations = 100,
-
- P = ?INTERFACE:open("p"),
-
- Refs = [?INTERFACE:hunt(P,"p"++integer_to_list(N))|| N <- lists:seq(1,Iterations)],
-
- Pids = [begin
- Prt = ?INTERFACE:open("p"++integer_to_list(N)),
- Pid = ?INTERFACE:get_id(Prt),
- ?INTERFACE:close(Prt),
- Pid
- end || N <- lists:seq(1,Iterations)],
-
- [receive
- {mailbox_up,P,Ref,Pid} ->
- ok
- after 10 ->
- ct:fail({did_not_get,Pid,Ref})
- end || {Pid,Ref} <- lists:zip(Pids,Refs)],
- ?INTERFACE:close(P).
-
-
-dehunt(_Config) ->
- [P1] = multi_open(1,[]),
- Ref = ?INTERFACE:hunt(P1,"p2"),
- receive
- _Else -> ct:fail({got,_Else})
- after 1000 ->
- ok
- end,
- P2 = ?INTERFACE:open("p2"),
-
- % Make sure any messages are sent
- receive after 10 -> ok end,
-
- ok = ?INTERFACE:dehunt(P1,Ref),
-
- % Make sure no messages are received
- receive
- _Else2 -> ct:fail({got,_Else2})
- after 1000 ->
- ?INTERFACE:close(P1),
- ?INTERFACE:close(P2)
- end.
-
-%%%
-%%% This testcase basically:
-%%% spawn 10 processes that in parallel
-%%% adds some hunts for different OSE processes
-%%% maybe create hunted OSE process
-%%% dehunt half of the hunts
-%%% create more hunts
-%%% if not created create hunted OSE process
-%%% veryify that all expected hunt messages are received
-%%% verify that all processes exited correctly
-%%%
-%%% This complex test is done to make sure that the internal handling
-%%% of dehunt works as expected.
-%%%
-multi_dehunt(_Config) ->
- [P1] = multi_open(1,[]),
-
- Scenario =
- fun(Iterations) ->
-
- Hunted = "p"++integer_to_list(Iterations),
- %% Start a couple of hunts
- Refs = [?INTERFACE:hunt(P1,Hunted) || _ <- lists:seq(1,Iterations)],
-
- %% We alternate if the process is opened before or after the dehunt
- P2O = if Iterations rem 2 == 0 ->
- ?INTERFACE:open(Hunted);
- true ->
- undefined
- end,
-
- %% Remove half of them
- {RemRefs,_} = lists:mapfoldl(fun(Ref,Acc) when Acc rem 2 == 0 ->
- ok = ?INTERFACE:dehunt(P1,Ref),
- {[],Acc+1};
- (Ref,Acc) ->
- {Ref,Acc+1}
- end,0,Refs),
-
- %% Add some new ones
- NewRefs = [?INTERFACE:hunt(P1,Hunted)
- || _ <- lists:seq(1,Iterations div 4)]
- ++ lists:flatten(RemRefs),
-
- P2 = if P2O == undefined ->
- ?INTERFACE:open(Hunted);
- true ->
- P2O
- end,
- P2Id = ?INTERFACE:get_id(P2),
-
- %% Receive all the expected ones
- lists:foreach(fun(Ref) ->
- receive
- {mailbox_up,P1,Ref,P2Id} ->
- ok
- after 1000 ->
- io:format("Flush: ~p~n",[flush()]),
- io:format("~p~n",[{Iterations,{did_not_get, Ref}}]),
- ok = Ref
- end
- end,NewRefs),
-
- %% Check that no other have arrived
- receive
- _Else ->
- io:format("Flush: ~p~n",[flush()]),
- io:format("~p~n",[{Iterations,{got, _Else}}]),
- ok = _Else
- after 100 ->
- ok
- end,
- ?INTERFACE:close(P2)
- end,
-
- Self = self(),
-
- n(fun(N) ->
- spawn(fun() -> Self !
- Scenario(N*25)
- end),
- ok
- end,10),
-
- n(fun(_N) ->
- receive ok -> ok
- after 60000 -> ct:fail(failed)
- end
- end,10),
- ?INTERFACE:close(P1).
-
-attach(_Config) ->
- [P1,P2] = multi_open(2,[]),
-
- P2Id = ?INTERFACE:get_id(P2),
- Ref = ?INTERFACE:attach(P1,P2Id),
- ?INTERFACE:close(P2),
- receive
- {mailbox_down,P1,Ref,P2Id} ->
- ?INTERFACE:close(P1);
- _Else ->
- ct:fail({got,_Else, {P1,Ref,P2Id}})
- after 1000 ->
- ct:fail({did_not_get,P1,Ref,P2Id})
- end.
-
-multi_attach(_Config) ->
-
- Iterations = 100,
-
- [P1|Pids] = multi_open(Iterations,[]),
-
- Refs = [{?INTERFACE:get_id(Pid),?INTERFACE:attach(P1,?INTERFACE:get_id(Pid))} || Pid <- Pids],
-
- [?INTERFACE:close(Pid) || Pid <- Pids],
-
- [receive
- {mailbox_down,P1,Ref,Pid} ->
- ok
- after 10000 ->
- ct:fail({did_not_get,Pid,Ref})
- end || {Pid,Ref} <- Refs],
- ?INTERFACE:close(P1).
-
-detach(_Config) ->
- [P1,P2] = multi_open(2,[]),
- P2Id = ?INTERFACE:get_id(P2),
- Ref = ?INTERFACE:attach(P1,P2Id),
- receive
- _Else -> ct:fail({got,_Else})
- after 100 ->
- ok
- end,
-
- ?INTERFACE:close(P2),
-
- % Make sure any messages are sent
- receive after 10 -> ok end,
-
- ?INTERFACE:detach(P1,Ref),
-
- % Make sure no messages are received
- receive
- _Else2 -> ct:fail({got,_Else2})
- after 1000 ->
- ?INTERFACE:close(P1)
- end.
-
-%%%
-%%% This testcase basically:
-%%% spawn 10 processes that in parallel
-%%% adds some attach for different OSE processes
-%%% maybe close OSE process
-%%% dehunt half of the hunts
-%%% create more hunts
-%%% if not closed close attached OSE process
-%%% veryify that all expected attach messages are received
-%%% verify that all processes exited correctly
-%%%
-%%% This complex test is done to make sure that the internal handling
-%%% of dehunt works as expected.
-%%%
-multi_detach(_Config) ->
- [P1] = multi_open(1,[]),
-
- Scenario =
- fun(Iterations) ->
-
- Attached = ?INTERFACE:open("p"++integer_to_list(Iterations)),
- AttachedId = ?INTERFACE:get_id(Attached),
- %% Start a couple of attachs
- Refs = [?INTERFACE:attach(P1,AttachedId) || _ <- lists:seq(1,Iterations)],
-
- %% We alternate if the process is closed before or after the detach
- P2O = if Iterations rem 2 == 0 ->
- ?INTERFACE:close(Attached);
- true ->
- undefined
- end,
-
- %% Remove half of them
- {RemRefs,_} = lists:mapfoldl(fun(Ref,Acc) when Acc rem 2 == 0 ->
- ok = ?INTERFACE:detach(P1,Ref),
- {[],Acc+1};
- (Ref,Acc) ->
- {Ref,Acc+1}
- end,0,Refs),
-
- %% Add some new ones
- NewRefs = [?INTERFACE:attach(P1,AttachedId)
- || _ <- lists:seq(1,Iterations div 4)]
- ++ lists:flatten(RemRefs),
-
- if P2O == undefined ->
- ?INTERFACE:close(Attached);
- true ->
- P2O
- end,
-
- %% Receive all the expected ones
- lists:foreach(fun(Ref) ->
- receive
- {mailbox_down,P1,Ref,AttachedId} ->
- ok
- after 1000 ->
- io:format("Flush: ~p~n",[flush()]),
- io:format("~p~n",[{Iterations,{did_not_get, Ref}}]),
- ok = Ref
- end
- end,NewRefs),
-
- %% Check that no other have arrived
- receive
- _Else ->
- io:format("Flush: ~p~n",[flush()]),
- io:format("~p~n",[{Iterations,{got, _Else}}]),
- ok = _Else
- after 100 ->
- ok
- end
- end,
-
- Self = self(),
-
- n(fun(N) ->
- spawn(fun() -> Self !
- Scenario(N*5)
- end),
- ok
- end,10),
-
- n(fun(_N) ->
- receive ok -> ok
- after 60000 -> ct:fail(failed)
- end
- end,10),
- ?INTERFACE:close(P1).
-
-
-open_errors(_Config) ->
- {'EXIT',{badarg,[{?INTERFACE,open,[inval],_}|_]}} =
- (catch ?INTERFACE:open(inval)),
- {'EXIT',{badarg,[{?INTERFACE,open,[["p"|1]],_}|_]}} =
- (catch ?INTERFACE:open(["p"|1])),
- {'EXIT',{badarg,[{?INTERFACE,open,[["p",1234]],_}|_]}} =
- (catch ?INTERFACE:open(["p",1234])),
-
- ok.
-
-close_errors(_Config) ->
- {'EXIT',{badarg,[{?INTERFACE,close,[inval],_}|_]}} =
- (catch ?INTERFACE:close(inval)),
-
- P1 = ?INTERFACE:open("p1"),
- ok = ?INTERFACE:close(P1),
- ok = ?INTERFACE:close(P1).
-
-
-get_id_errors(_Config) ->
- {'EXIT',{badarg,[{?INTERFACE,get_id,[inval],_}|_]}} =
- (catch ?INTERFACE:get_id(inval)),
-
- P1 = ?INTERFACE:open("p1"),
- ok = ?INTERFACE:close(P1),
- {'EXIT',{badarg,[{?INTERFACE,get_id,[P1],_}|_]}} =
- (catch ?INTERFACE:get_id(P1)),
-
- ok.
-
-get_name_errors(_Config) ->
- P1 = ?INTERFACE:open("p1"),
- {'EXIT',{badarg,[{?INTERFACE,get_name,[P1,inval],_}|_]}} =
- (catch ?INTERFACE:get_name(P1,inval)),
-
- undefined = ?INTERFACE:get_name(P1,1234),
-
- P2 = ?INTERFACE:open("p2"),
- P2Id = ?INTERFACE:get_id(P2),
- ok = ?INTERFACE:close(P1),
- {'EXIT',{badarg,[{?INTERFACE,get_name,[P1,P2Id],_}|_]}} =
- (catch ?INTERFACE:get_name(P1,P2Id)),
- ?INTERFACE:close(P2),
-
- P3 = ?INTERFACE:open([255]),
- <<255>> = ?INTERFACE:get_name(P3, ?INTERFACE:get_id(P3)),
- ?INTERFACE:close(P3),
-
- ok.
-
-hunt_errors(_Config) ->
-
- {'EXIT',{badarg,[{?INTERFACE,hunt,[inval,"hello"],_}|_]}} =
- (catch ?INTERFACE:hunt(inval,"hello")),
-
- P1 = ?INTERFACE:open("p1"),
- {'EXIT',{badarg,[{?INTERFACE,hunt,[P1,["hello",12345]],_}|_]}} =
- (catch ?INTERFACE:hunt(P1,["hello",12345])),
-
- P2 = ?INTERFACE:open(<<255>>),
- P2Pid = ?INTERFACE:get_id(P2),
- Ref = ?INTERFACE:hunt(P1,[255]),
- receive
- {mailbox_up,P1,Ref,P2Pid} ->
- ok;
- Else ->
- ct:fail({got,Else,{mailbox_up,P1,Ref,P2Pid}})
- after 150 ->
- ct:fail({did_not_get,{mailbox_up,P1,Ref,P2Pid}})
- end,
-
- ok = ?INTERFACE:close(P1),
- ok = ?INTERFACE:close(P2),
- {'EXIT',{badarg,[{?INTERFACE,hunt,[P1,["hello"]],_}|_]}} =
- (catch ?INTERFACE:hunt(P1,["hello"])),
-
- ok.
-
-dehunt_errors(_Config) ->
- P1 = ?INTERFACE:open("p1"),
- Ref = ?INTERFACE:hunt(P1,"p2"),
-
- {'EXIT',{badarg,[{?INTERFACE,dehunt,[inval,Ref],_}|_]}} =
- (catch ?INTERFACE:dehunt(inval,Ref)),
-
- {'EXIT',{badarg,[{?INTERFACE,dehunt,[P1,inval],_}|_]}} =
- (catch ?INTERFACE:dehunt(P1,inval)),
-
- ok = ?INTERFACE:dehunt(P1,Ref),
- ok = ?INTERFACE:dehunt(P1,Ref),
-
- ok = ?INTERFACE:close(P1),
-
- {'EXIT',{badarg,[{?INTERFACE,dehunt,[P1,Ref],_}|_]}} =
- (catch ?INTERFACE:dehunt(P1,Ref)),
-
- case ?INTERFACE of
- ose -> ok;
- _ ->
- P2 = ?INTERFACE:open("p2"),
- ok = ?INTERFACE:close(P2)
- end,
-
- receive
- Else -> ct:fail({got,Else})
- after 100 ->
- ok
- end.
-
-attach_errors(_Config) ->
- P1 = ?INTERFACE:open("p1"),
- P2 = ?INTERFACE:open("p2"),
- P2Id = ?INTERFACE:get_id(P2),
-
- {'EXIT',{badarg,[{?INTERFACE,attach,[inval,P2Id],_}|_]}} =
- (catch ?INTERFACE:attach(inval,P2Id)),
-
- {'EXIT',{badarg,[{?INTERFACE,attach,[P1,[12345]],_}|_]}} =
- (catch ?INTERFACE:attach(P1,[12345])),
-
- ok = ?INTERFACE:close(P1),
- ok = ?INTERFACE:close(P2),
- {'EXIT',{badarg,[{?INTERFACE,attach,[P1,P2Id],_}|_]}} =
- (catch ?INTERFACE:attach(P1,P2Id)),
-
- ok.
-
-detach_errors(_Config) ->
- P1 = ?INTERFACE:open("p1"),
- P2 = ?INTERFACE:open("p2"),
- P2Id = ?INTERFACE:get_id(P2),
-
- Ref = ?INTERFACE:attach(P1,P2Id),
-
- {'EXIT',{badarg,[{?INTERFACE,detach,[inval,Ref],_}|_]}} =
- (catch ?INTERFACE:detach(inval,Ref)),
-
- {'EXIT',{badarg,[{?INTERFACE,detach,[P1,inval],_}|_]}} =
- (catch ?INTERFACE:detach(P1,inval)),
-
- ok = ?INTERFACE:detach(P1,Ref),
- ok = ?INTERFACE:detach(P1,Ref),
-
- case ?INTERFACE of
- ose -> ok;
- _ ->
- ok = ?INTERFACE:close(P1)
- end,
-
- ok = ?INTERFACE:close(P2),
- ok = ?INTERFACE:close(P1),
-
- {'EXIT',{badarg,[{?INTERFACE,detach,[P1,Ref],_}|_]}} =
- (catch ?INTERFACE:detach(P1,Ref)),
-
- receive
- Else -> ct:fail({got,Else})
- after 100 ->
- ok
- end.
-
-send_errors(_Config) ->
- P1 = ?INTERFACE:open("p1"),
- P2 = ?INTERFACE:open("p2"),
- P2Id = ?INTERFACE:get_id(P2),
-
- {'EXIT',{badarg,[{?INTERFACE,send,[inval,P2Id,42,"hello"],_}|_]}} =
- (catch ?INTERFACE:send(inval,P2Id,42,"hello")),
- {'EXIT',{badarg,[{?INTERFACE,send,[P1,inval,42,"hello"],_}|_]}} =
- (catch ?INTERFACE:send(P1,inval,42,"hello")),
- {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,inval,"hello"],_}|_]}} =
- (catch ?INTERFACE:send(P1,P2Id,inval,"hello")),
- {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,42,inval],_}|_]}} =
- (catch ?INTERFACE:send(P1,P2Id,42,inval)),
-
- ok = ?INTERFACE:close(P2),
- ok = ?INTERFACE:send(P1,P2Id,42,"hello"),
- ok = ?INTERFACE:close(P1),
-
- {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,42,"hello"],_}|_]}} =
- (catch ?INTERFACE:send(P1,P2Id,42,"hello")),
-
- receive
- Else -> ct:fail({got,Else})
- after 100 ->
- ok
- end.
-
-send_w_s_errors(_Config) ->
- P1 = ?INTERFACE:open("p1"),
- P1Id = ?INTERFACE:get_id(P1),
- P2 = ?INTERFACE:open("p2"),
- P2Id = ?INTERFACE:get_id(P2),
- P3 = ?INTERFACE:open("p3"),
- P3Id = ?INTERFACE:get_id(P3),
-
- {'EXIT',{badarg,[{?INTERFACE,send,[inval,P2Id,P1Id,42,"hello"],_}|_]}} =
- (catch ?INTERFACE:send(inval,P2Id,P1Id,42,"hello")),
- {'EXIT',{badarg,[{?INTERFACE,send,[P2,-1,P1Id,42,"hello"],_}|_]}} =
- (catch ?INTERFACE:send(P2,-1,P1Id,42,"hello")),
- {'EXIT',{badarg,[{?INTERFACE,send,[P2,P2Id,1 bsl 32,42,"hello"],_}|_]}} =
- (catch ?INTERFACE:send(P2,P2Id,1 bsl 32,42,"hello")),
- {'EXIT',{badarg,[{?INTERFACE,send,[P2,P2Id,P1Id,inval,"hello"],_}|_]}} =
- (catch ?INTERFACE:send(P2,P2Id,P1Id,inval,"hello")),
- {'EXIT',{badarg,[{?INTERFACE,send,[P2,P2Id,P1Id,42,inval],_}|_]}} =
- (catch ?INTERFACE:send(P2,P2Id,P1Id,42,inval)),
-
- ok = ?INTERFACE:close(P3),
- ok = ?INTERFACE:send(P2,P3Id,P1Id,42,"hello"),
-
- ok = ?INTERFACE:close(P1),
- ok = ?INTERFACE:send(P2,P2Id,P1Id,42,"hello"),
- ok = ?INTERFACE:close(P2),
-
- {'EXIT',{badarg,[{?INTERFACE,send,[P1,P2Id,P1Id,42,"hello"],_}|_]}} =
- (catch ?INTERFACE:send(P1,P2Id,P1Id,42,"hello")),
-
- receive
- Else -> ct:fail({got,Else})
- after 100 ->
- ok
- end.
-
-listen_errors(_Config) ->
-
- P1 = ?INTERFACE:open("p1"),
- P1Id = ?INTERFACE:get_id(P1),
-
- {'EXIT',{badarg,[{?INTERFACE,listen,[inval,[42]],_}|_]}} =
- (catch ?INTERFACE:listen(inval,[42])),
- {'EXIT',{badarg,[{?INTERFACE,listen,[P1,inval],_}|_]}} =
- (catch ?INTERFACE:listen(P1,inval)),
- {'EXIT',{badarg,[{?INTERFACE,listen,[P1,[1 bsl 33]],_}|_]}} =
- (catch ?INTERFACE:listen(P1,[1 bsl 33])),
-
- ok = ?INTERFACE:listen(P1,[42,42,42,42,42,42,42,42,42,42,42,42,42]),
-
- case ?INTERFACE of
- ose -> ok;
- _ ->
- ?INTERFACE:send(P1,P1Id,42,"hello"),
- timer:sleep(50),
- ?INTERFACE:listen(P1,[]),
- ?INTERFACE:send(P1,P1Id,42,"hello2"),
-
- receive
- {message,P1,42,"hello"} -> ok
- end,
-
- receive
- Else -> ct:fail({got,Else})
- after 100 ->
- ok
- end
- end,
-
- ok = ?INTERFACE:close(P1),
- {'EXIT',{badarg,[{?INTERFACE,listen,[P1,[42]],_}|_]}} =
- (catch ?INTERFACE:listen(P1,[42])),
-
- ok.
-
-%%
-%% Internal functions
-%%
-multi_open(N,ListenNums) ->
- multi_open(N,ListenNums,[]).
-
-multi_open(0,_,Acc) ->
- Acc;
-multi_open(N,ListenNums,Acc) ->
- P = ?INTERFACE:open("p"++integer_to_list(N)),
- ok = ?INTERFACE:listen(P,ListenNums),
- multi_open(N-1,ListenNums,[P|Acc]).
-
-n(_F,0) ->
- ok;
-n(F,N) ->
- ok = F(N),
- n(F,N-1).
-
-
-flush() ->
- receive
- Msg ->
- [Msg|flush()]
- after 0 ->
- []
- end.
diff --git a/lib/ose/vsn.mk b/lib/ose/vsn.mk
deleted file mode 100644
index fb1cf8219f..0000000000
--- a/lib/ose/vsn.mk
+++ /dev/null
@@ -1 +0,0 @@
-OSE_VSN = 1.1
diff --git a/lib/otp_mibs/test/Makefile b/lib/otp_mibs/test/Makefile
index e1cfbb347d..18d7e915db 100644
--- a/lib/otp_mibs/test/Makefile
+++ b/lib/otp_mibs/test/Makefile
@@ -49,7 +49,6 @@ RELSYSDIR = $(RELEASE_PATH)/otp_mibs_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
ERL_COMPILE_FLAGS += \
- -I$(ERL_TOP)/lib/test_server/include \
-I$(ERL_TOP)/lib/snmp/include
# ----------------------------------------------------
diff --git a/lib/otp_mibs/test/otp_mibs_SUITE.erl b/lib/otp_mibs/test/otp_mibs_SUITE.erl
index abb5aa8194..4d1eb155cd 100644
--- a/lib/otp_mibs/test/otp_mibs_SUITE.erl
+++ b/lib/otp_mibs/test/otp_mibs_SUITE.erl
@@ -30,7 +30,7 @@
%% > ct_run -suite otp_mibs_SUITE -config otp_mibs_SUITE.cfg
%%-----------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("otp_mibs/include/OTP-MIB.hrl").
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/parsetools/test/Makefile b/lib/parsetools/test/Makefile
index f84bb0e75e..75f9624fd5 100644
--- a/lib/parsetools/test/Makefile
+++ b/lib/parsetools/test/Makefile
@@ -41,7 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/parsetools_test
# FLAGS
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/parsetools/test/leex_SUITE.erl b/lib/parsetools/test/leex_SUITE.erl
index 1e3738de85..f5ff32c358 100644
--- a/lib/parsetools/test/leex_SUITE.erl
+++ b/lib/parsetools/test/leex_SUITE.erl
@@ -31,7 +31,7 @@
-define(privdir, "leex_SUITE_priv").
-define(t, test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(datadir, ?config(data_dir, Config)).
-define(privdir, ?config(priv_dir, Config)).
-endif.
diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl
index 6603a5a07d..a1bb5eb16c 100644
--- a/lib/parsetools/test/yecc_SUITE.erl
+++ b/lib/parsetools/test/yecc_SUITE.erl
@@ -30,7 +30,7 @@
-define(privdir, "yecc_SUITE_priv").
-define(t, test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(datadir, ?config(data_dir, Config)).
-define(privdir, ?config(priv_dir, Config)).
-endif.
diff --git a/lib/percept/test/Makefile b/lib/percept/test/Makefile
index 4ba0b80fc8..6891de832d 100644
--- a/lib/percept/test/Makefile
+++ b/lib/percept/test/Makefile
@@ -52,8 +52,7 @@ RELSYSDIR = $(RELEASE_PATH)/percept_test
# FLAGS
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \
- -I$(ERL_TOP)/lib/percept/include
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/percept/include
# ----------------------------------------------------
# Targets
diff --git a/lib/percept/test/egd_SUITE.erl b/lib/percept/test/egd_SUITE.erl
index 41e8999e17..0b1149e1f1 100644
--- a/lib/percept/test/egd_SUITE.erl
+++ b/lib/percept/test/egd_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(egd_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
@@ -40,7 +40,7 @@
-define(default_timeout, ?t:minutes(1)).
init_per_suite(Config) when is_list(Config) ->
- random:seed(now()),
+ rand:seed(exsplus),
Config.
end_per_suite(Config) when is_list(Config) ->
@@ -348,4 +348,4 @@ get_points(0, Out) ->
get_points(N, Out) ->
get_points(N - 1, [get_point() | Out]).
-random(N) -> trunc(random:uniform(trunc(N + 1)) - 1).
+random(N) -> trunc(rand:uniform(trunc(N + 1)) - 1).
diff --git a/lib/percept/test/percept_SUITE.erl b/lib/percept/test/percept_SUITE.erl
index fd96c2b97a..06d62630ba 100644
--- a/lib/percept/test/percept_SUITE.erl
+++ b/lib/percept/test/percept_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(percept_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
diff --git a/lib/percept/test/percept_db_SUITE.erl b/lib/percept/test/percept_db_SUITE.erl
index e2775aabc0..5b878e8462 100644
--- a/lib/percept/test/percept_db_SUITE.erl
+++ b/lib/percept/test/percept_db_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(percept_db_SUITE).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/1]).
diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl
index 4c3f76bdc6..9ac22b9450 100644
--- a/lib/reltool/src/reltool.hrl
+++ b/lib/reltool/src/reltool.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
@@ -141,15 +141,15 @@
app_name :: '_' | app_name(),
incl_cond :: '_' | incl_cond() | undefined,
debug_info :: '_' | debug_info() | undefined,
- is_app_mod :: '_' | boolean(),
- is_ebin_mod :: '_' | boolean(),
- uses_mods :: '$2' | [mod_name()],
- exists :: '_' | boolean(),
+ is_app_mod :: '_' | boolean() | undefined,
+ is_ebin_mod :: '_' | boolean() | undefined,
+ uses_mods :: '$2' | [mod_name()] | undefined,
+ exists :: '_' | boolean() | undefined,
%% Dynamic
- status :: '_' | status(),
- used_by_mods :: '_' | [mod_name()],
- is_pre_included :: '_' | boolean() | undefined,
- is_included :: '_' | boolean() | undefined
+ status = ok :: '_' | status(),
+ used_by_mods = [] :: '_' | [mod_name()],
+ is_pre_included :: '_' | boolean() | undefined,
+ is_included :: '_' | boolean() | undefined
}).
-record(app_info,
@@ -177,10 +177,10 @@
name :: '_' | app_name(),
is_escript :: '_' | boolean() | {inlined, escript_app_name()},
use_selected_vsn :: '_' | vsn | dir | undefined,
- active_dir :: '_' | dir(),
+ active_dir :: '_' | dir() | undefined,
sorted_dirs :: '_' | [dir()],
- vsn :: '_' | app_vsn(),
- label :: '_' | app_label(),
+ vsn :: '_' | app_vsn() | undefined,
+ label :: '_' | app_label() | undefined,
info :: '_' | #app_info{} | undefined,
mods :: '_' | [#mod{}],
@@ -192,21 +192,21 @@
debug_info :: '_' | debug_info() | undefined,
app_file :: '_' | app_file() | undefined,
app_type :: '_' | app_type() | undefined,
- incl_app_filters :: '_' | [#regexp{}],
- excl_app_filters :: '_' | [#regexp{}],
- incl_archive_filters :: '_' | [#regexp{}],
- excl_archive_filters :: '_' | [#regexp{}],
- archive_opts :: '_' | [archive_opt()],
+ incl_app_filters :: '_' | [#regexp{}] | undefined,
+ excl_app_filters :: '_' | [#regexp{}] | undefined,
+ incl_archive_filters :: '_' | [#regexp{}] | undefined,
+ excl_archive_filters :: '_' | [#regexp{}] | undefined,
+ archive_opts :: '_' | [archive_opt()] | undefined,
%% Dynamic
status :: '_' | status(),
- uses_mods :: '_' | [mod_name()],
- used_by_mods :: '_' | [mod_name()],
- uses_apps :: '_' | [app_name()],
- used_by_apps :: '_' | [app_name()],
+ uses_mods :: '_' | [mod_name()] | undefined,
+ used_by_mods :: '_' | [mod_name()] | undefined,
+ uses_apps :: '_' | [app_name()] | undefined,
+ used_by_apps :: '_' | [app_name()] | undefined,
is_pre_included :: '_' | '$2' | boolean() | undefined,
is_included :: '_' | '$1' | boolean() | undefined,
- rels :: '_' | [rel_name()]
+ rels :: '_' | [rel_name()] | undefined
}).
-record(rel_app,
@@ -237,7 +237,7 @@
rels :: [#rel{}],
emu_name :: emu_name(),
profile :: profile(),
- excl_lib :: excl_lib(),
+ excl_lib :: excl_lib() | undefined,
incl_sys_filters :: [#regexp{}],
excl_sys_filters :: [#regexp{}],
incl_app_filters :: [#regexp{}],
diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl
index 6b58cae187..deab502bfe 100644
--- a/lib/reltool/src/reltool_fgraph_win.erl
+++ b/lib/reltool/src/reltool_fgraph_win.erl
@@ -220,8 +220,8 @@ graph_add_node_unsure(Key, State, G = #graph{ vs = Vs }) ->
graph_add_node(Key, Color, G = #graph{ vs = Vs}) ->
Q = 20.0, % repulsive force
M = 0.5, % mass
- P = {float(450 + random:uniform(100)),
- float(450 + random:uniform(100))},
+ P = {float(450 + rand:uniform(100)),
+ float(450 + rand:uniform(100))},
G#graph{ vs = reltool_fgraph:add(Key,
#fg_v{ p = P, m = M, q = Q, color = Color},
Vs)}.
diff --git a/lib/runtime_tools/c_src/Makefile.in b/lib/runtime_tools/c_src/Makefile.in
index 448b8c62c2..aeacee0655 100644
--- a/lib/runtime_tools/c_src/Makefile.in
+++ b/lib/runtime_tools/c_src/Makefile.in
@@ -102,12 +102,7 @@ endif
_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR))
-ifneq ($(findstring ose,$(TARGET)),ose)
debug opt valgrind: $(SOLIBS) $(OBJDIR) $(LIBDIR) $(NIF_LIB)
-else
-# We do not build this on OSE
-debug opt valgrind:
-endif
DYNTRACE_OBJS = $(before_DTrace_OBJS)
@@ -159,10 +154,8 @@ include $(ERL_TOP)/make/otp_release_targets.mk
release_spec: opt
$(INSTALL_DIR) "$(RELSYSDIR)/priv/obj"
$(INSTALL_DIR) "$(RELSYSDIR)/priv/lib"
-ifneq ($(findstring ose,$(TARGET)),ose)
$(INSTALL_PROGRAM) $(DYNTRACE_OBJS) "$(RELSYSDIR)/priv/obj"
$(INSTALL_PROGRAM) $(NIF_LIB) $(SOLIBS) "$(RELSYSDIR)/priv/lib"
-endif
release_docs_spec:
diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile
index 0292333f0a..38725807ae 100644
--- a/lib/runtime_tools/doc/src/Makefile
+++ b/lib/runtime_tools/doc/src/Makefile
@@ -41,7 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
# Target Specs
# ----------------------------------------------------
XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml
+XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml msacc.xml
XML_REF6_FILES = runtime_tools_app.xml
XML_PART_FILES = part_notes.xml part_notes_history.xml part.xml
diff --git a/lib/runtime_tools/doc/src/msacc.xml b/lib/runtime_tools/doc/src/msacc.xml
new file mode 100644
index 0000000000..129da3d230
--- /dev/null
+++ b/lib/runtime_tools/doc/src/msacc.xml
@@ -0,0 +1,305 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2014</year><year>2014</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+ </legalnotice>
+
+ <title>Microstate Accounting</title>
+ <prepared>Lukas Larsson</prepared>
+ <responsible></responsible>
+ <docno>1</docno>
+ <approved></approved>
+ <checked></checked>
+ <date>14-09-30</date>
+ <rev>A</rev>
+ <file>msacc.xml</file>
+ </header>
+ <module>msacc</module>
+ <modulesummary>Convenience functions for microstate accounting</modulesummary>
+ <description>
+ <p>This module implements some convenience functions for analyzing
+ microstate accounting data. For details about how to use the basic api and
+ what the different states represent see
+ <seealso marker="erts:erlang#statistics_microstate_accounting"><c>
+ erlang:statistics(microstate_accounting)</c></seealso>.</p>
+ <marker id="msacc_print_example"></marker>
+ <p><em>Basic Scenario</em></p>
+ <pre>1> <input>msacc:start(1000).</input>
+ok
+2> <input>msacc:print().</input>
+Average thread real-time : 1000513 us
+Accumulated system run-time : 2213 us
+Average scheduler run-time : 1076 us
+
+ Thread aux check_io emulator gc other port sleep
+
+Stats per thread:
+ async( 0) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00%
+ async( 1) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00%
+ aux( 1) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 99.99%
+ scheduler( 1) 0.00% 0.03% 0.13% 0.00% 0.01% 0.00% 99.82%
+ scheduler( 2) 0.00% 0.00% 0.00% 0.00% 0.03% 0.00% 99.97%
+
+Stats per type:
+ async 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00%
+ aux 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 99.99%
+ scheduler 0.00% 0.02% 0.06% 0.00% 0.02% 0.00% 99.89%
+ok
+</pre>
+ <p>This first command enables microstate accounting for 1000 milliseconds.
+ See <seealso marker="#start-0"><c>start/0</c></seealso>,
+ <seealso marker="#stop-0"><c>stop/0</c></seealso>,
+ <seealso marker="#reset-0"><c>reset/0</c></seealso> and
+ <seealso marker="#start-1"><c>start/1</c></seealso> for more details.
+ The second command prints the statistics gathered during that time.
+ First three general statistics are printed.</p>
+ <taglist>
+ <tag>Average real-time</tag>
+ <item>The average time spent collecting data in the threads.
+ This should be close to the time which data was collected.
+ </item>
+ <tag>System run-time</tag>
+ <item>The total run-time of all threads in the system.
+ This is what you get if you call <c>msacc:stats(total_runtime,Stats).</c>
+ </item>
+ <tag>Average scheduler run-time</tag>
+ <item>The average run-time for the schedulers.
+ This is the average amount of time the schedulers did not sleep.</item>
+ </taglist>
+ <p>Then one column per state is printed with a the percentage of time this
+ thread spent in the state out of it's own real-time. After the thread
+ specific time, the accumulated time for each type of thread is printed in
+ a similar format.</p>
+ <p>Since we have the average real-time and the percentage spent in each
+ state we can easily calculate the time spent in each state by multiplying
+ <c>Average thread real-time</c> with <c>Thread state %</c>, i.e. to
+ get the time Scheduler 1 spent in the emulator state we do
+ <c>1000513us * 0.13% = 1300us</c>.</p>
+ </description>
+ <datatypes>
+ <datatype>
+ <name name="msacc_data"/>
+ </datatype>
+ <datatype>
+ <name name="msacc_data_thread"/>
+ </datatype>
+ <datatype>
+ <name name="msacc_data_counters"/>
+ <desc><p>A map containing the different microstate accounting states and
+ the number of microseconds spent in it.</p></desc>
+ </datatype>
+ <datatype>
+ <name name="msacc_stats"/>
+ </datatype>
+ <datatype>
+ <name name="msacc_stats_thread"/>
+ <desc><p>A map containing information about a specific thread. The
+ percentages in the map can be either run-time or real-time depending
+ on if <c>runtime</c> or <c>realtime</c> was requested from
+ <seealso marker="#stats-2">stats/2</seealso>. <c>system</c> is the
+ percentage of total system time for this specific thread.</p></desc>
+ </datatype>
+ <datatype>
+ <name name="msacc_stats_counters"/>
+ <desc><p>A map containing the different microstate accounting states. Each
+ value in the map contains another map with the percentage of time that
+ this thread has spent in the specific state. Both the percentage of
+ <c>system</c> time and the time for that specific <c>thread</c> is part of
+ the map.</p></desc>
+ </datatype>
+ <datatype>
+ <name name="msacc_type"/>
+ </datatype>
+ <datatype>
+ <name name="msacc_id"/>
+ </datatype>
+ <datatype>
+ <name name="msacc_state"/>
+ <desc><p>The different states that a thread can be in. See
+ <seealso marker="erts:erlang#statistics_microstate_accounting">
+ erlang:statistics(microstate_accounting)</seealso> for details.
+ </p></desc>
+ </datatype>
+ <datatype>
+ <name name="msacc_print_options"/>
+ <desc><p>The different options that can be given to
+ <seealso marker="#print-2"><c>print/2</c></seealso>.
+ </p></desc>
+ </datatype>
+ </datatypes>
+ <funcs>
+ <func>
+ <name name="available" arity="0"/>
+ <fsummary>Check if microstate accounting is available</fsummary>
+ <desc>
+ <p>This function checks whether microstate accounting
+ is available or not.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="start" arity="0"/>
+ <fsummary>Start microstate accounting.</fsummary>
+ <desc>
+ <p>Start microstate accounting. Returns whether it was
+ previously enabled or disabled.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="start" arity="1"/>
+ <fsummary>Start microstate accounting for a time.</fsummary>
+ <desc>
+ <p>Resets all counters and then starts microstate accounting
+ for the given milliseconds.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="stop" arity="0"/>
+ <fsummary>Stop microstate accounting.</fsummary>
+ <desc>
+ <p>Stop microstate accounting.
+ Returns whether is was previously enabled or disabled.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="reset" arity="0"/>
+ <fsummary>Reset microstate accounting counters</fsummary>
+ <desc>
+ <p>Reset microstate accounting counters.
+ Returns whether is was enabled or disabled.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="print" arity="0"/>
+ <fsummary>Print microstate statistics</fsummary>
+ <desc>
+ <p>
+ Prints the current microstate accounting to standard out.
+ Same as
+ <seealso marker="#print-1">
+ <c>msacc:print(msacc:stats(),#{}).</c>
+ </seealso>
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name name="print" arity="1"/>
+ <fsummary>Print microstate statistics</fsummary>
+ <desc>
+ <p>Print the given microstate statistics values to stdout.
+ Same as
+ <seealso marker="#print-1">
+ <c>msacc:print(DataOrStats,#{}).</c>
+ </seealso>
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name name="print" arity="2"/>
+ <fsummary>Print microstate statistics</fsummary>
+ <desc>
+ <p>Print the given microstate statistics values to standard out.
+ With many states this can be quite verbose. See the top of this
+ reference manual for a brief description of what the fields mean.</p>
+ <p>It is possible to print more specific types of statistics by
+ first manipulating the <c>DataOrStats</c> using
+ <seealso marker="#stats-2"><c>stats/2</c></seealso>.
+ For instance if you want to print the percentage of run-time for each
+ thread you can do:</p>
+ <pre><input>msacc:print(msacc:stats(runtime,msacc:stats())).</input></pre>
+ <p>If you want to only print run-time per thread type you can do:</p>
+ <pre><input>msacc:print(msacc:stats(type,msacc:stats(runtime,msacc:stats()))).</input></pre>
+ <p><em>Options</em></p>
+ <taglist>
+ <tag><c>system</c></tag><item>Print percentage of time spent in each
+ state out of system time as well as thread time.
+ Default: false.</item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name name="print" arity="3"/>
+ <fsummary>Print microstate statistics</fsummary>
+ <desc>
+ <p>Print the given microstate statistics values to the given file
+ or device. The other arguments behave the same way as for
+ <seealso marker="#print-2"><c>print/2</c></seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="stats" arity="0"/>
+ <fsummary></fsummary>
+ <desc>
+ <p>Returns a runtime system independent version of the microstate
+ statistics data presented by
+ <seealso marker="erts:erlang#statistics_microstate_accounting">
+ <c>erlang:statistics(microstate_accounting)</c></seealso>.
+ All counters have been normalized to be in microsecond resolution.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="stats" arity="2" clause_i="1"/>
+ <fsummary></fsummary>
+ <desc>
+ <p>Returns the system time for the given microstate statistics values.
+ System time is the accumulated time of all threads.</p>
+ <taglist>
+ <tag><c>realtime</c></tag>
+ <item>Returns all time recorded for all threads.</item>
+ <tag><c>runtime</c></tag>
+ <item>Returns all time spent doing work for all threads, i.e.
+ all time not spent in the <c>sleep</c> state.</item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name name="stats" arity="2" clause_i="2"/>
+ <fsummary></fsummary>
+ <desc>
+ <p>Returns fractions of real-time or run-time spent in the various
+ threads from the given microstate statistics values.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="stats" arity="2" clause_i="3"/>
+ <fsummary></fsummary>
+ <desc>
+ <p>Returns a list of microstate statistics values where the values
+ for all threads of the same type has been merged.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="to_file" arity="1"/>
+ <fsummary></fsummary>
+ <desc>
+ <p>Dumps the current microstate statistics counters to a file that can
+ be parsed with <seealso marker="kernel:file#consult/1">
+ file:consult/1</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="from_file" arity="1"/>
+ <fsummary></fsummary>
+ <desc>
+ <p>Read a file dump produced by <seealso marker="#to_file/1">
+ to_file(Filename)</seealso>.</p>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
diff --git a/lib/runtime_tools/doc/src/ref_man.xml b/lib/runtime_tools/doc/src/ref_man.xml
index ea0c0832a4..8657a07a30 100644
--- a/lib/runtime_tools/doc/src/ref_man.xml
+++ b/lib/runtime_tools/doc/src/ref_man.xml
@@ -36,6 +36,7 @@
<xi:include href="dbg.xml"/>
<xi:include href="dyntrace.xml"/>
<xi:include href="erts_alloc_config.xml"/>
+ <xi:include href="msacc.xml"/>
<xi:include href="system_information.xml"/>
</application>
diff --git a/lib/runtime_tools/doc/src/specs.xml b/lib/runtime_tools/doc/src/specs.xml
index d4c3c9dfe6..978bd39e55 100644
--- a/lib/runtime_tools/doc/src/specs.xml
+++ b/lib/runtime_tools/doc/src/specs.xml
@@ -1,4 +1,5 @@
<?xml version="1.0" encoding="utf-8" ?>
<specs xmlns:xi="http://www.w3.org/2001/XInclude">
<xi:include href="../specs/specs_system_information.xml"/>
+ <xi:include href="../specs/specs_msacc.xml"/>
</specs>
diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile
index 99b90f9ec5..3b41184f4e 100644
--- a/lib/runtime_tools/src/Makefile
+++ b/lib/runtime_tools/src/Makefile
@@ -45,7 +45,9 @@ MODULES= \
percept_profile \
system_information \
observer_backend \
- ttb_autostart
+ ttb_autostart\
+ msacc
+
HRL_FILES= ../include/observer_backend.hrl
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl
new file mode 100644
index 0000000000..612effa5aa
--- /dev/null
+++ b/lib/runtime_tools/src/msacc.erl
@@ -0,0 +1,355 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2015. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% @doc Microstate accounting utility function
+%%
+%% This module provides a user interface for analysing
+%% erlang:statistics(microstate_accounting) data.
+%%
+
+-module(msacc).
+-export([available/0, start/0, start/1, stop/0, reset/0, to_file/1,
+ from_file/1, stats/0, stats/2, print/0, print/1, print/2,
+ print/3]).
+
+-type msacc_data() :: [msacc_data_thread()].
+
+-type msacc_data_thread() :: #{ '$type' => msacc_data,
+ type => msacc_type(), id => msacc_id(),
+ counters => msacc_data_counters() }.
+-type msacc_data_counters() :: #{ msacc_state() => non_neg_integer()}.
+
+-type msacc_stats() :: [msacc_stats_thread()].
+-type msacc_stats_thread() :: #{ '$type' => msacc_stats,
+ type => msacc_type(), id => msacc_id(),
+ system => float(),
+ counters => msacc_stats_counters()}.
+-type msacc_stats_counters() :: #{ msacc_state() => #{ thread => float(),
+ system => float()}}.
+
+
+-type msacc_type() :: scheduler | aux | async.
+-type msacc_id() :: non_neg_integer().
+-type msacc_state() :: alloc | aux | bif | busy_wait | check_io |
+ emulator | ets | gc | gc_fullsweep | nif |
+ other | port | send | sleep | timers.
+
+-type msacc_print_options() :: #{ system => boolean() }.
+
+-spec available() -> boolean().
+available() ->
+ try
+ [_|_] = erlang:statistics(microstate_accounting),
+ true
+ catch _:_ ->
+ false
+ end.
+
+-spec start() -> boolean().
+start() ->
+ erlang:system_flag(microstate_accounting, true).
+
+-spec stop() -> boolean().
+stop() ->
+ erlang:system_flag(microstate_accounting, false).
+
+-spec reset() -> boolean().
+reset() ->
+ erlang:system_flag(microstate_accounting, reset).
+
+-spec start(Time) -> true when
+ Time :: timeout().
+start(Tmo) ->
+ stop(), reset(), start(),
+ timer:sleep(Tmo),
+ stop().
+
+-spec to_file(Filename) -> ok | {error, file:posix()} when
+ Filename :: file:name_all().
+to_file(Filename) ->
+ file:write_file(Filename, io_lib:format("~p.~n",[stats()])).
+
+-spec from_file(Filename) -> msacc_data() when
+ Filename :: file:name_all().
+from_file(Filename) ->
+ {ok, [Stats]} = file:consult(Filename),
+ Stats.
+
+-spec print() -> ok.
+print() ->
+ print(stats()).
+
+-spec print(DataOrStats) -> ok when
+ DataOrStats :: msacc_data() | msacc_stats().
+print(Stats) ->
+ print(Stats, #{}).
+
+-spec print(DataOrStats, Options) -> ok when
+ DataOrStats :: msacc_data() | msacc_stats(),
+ Options :: msacc_print_options().
+print(Stats, Options) ->
+ print(group_leader(), Stats, Options).
+
+-spec print(FileOrDevice, DataOrStats, Options) -> ok when
+ FileOrDevice :: file:filename() | io:device(),
+ DataOrStats :: msacc_data() | msacc_stats(),
+ Options :: msacc_print_options().
+print(Filename, Stats, Options) when is_list(Filename) ->
+ case file:open(Filename,[write]) of
+ {ok, D} -> print(D, Stats, Options),file:close(D);
+ Error -> Error
+ end;
+print(Device, Stats, Options) ->
+ DefaultOpts = #{ system => false },
+ print_int(Device, Stats, maps:merge(DefaultOpts, Options)).
+print_int(Device, [#{ '$type' := msacc_data, id := _Id }|_] = Stats, Options) ->
+ TypeStats = stats(type, Stats),
+ io:format(Device, "~s", [print_stats_overview(Stats, Options)]),
+ io:format(Device, "~s", [print_stats_header(Stats, Options)]),
+ io:format(Device, "~s", [print_stats_threads(
+ stats(realtime, Stats), Options)]),
+ io:format(Device, "~s", [print_stats_type(
+ stats(realtime, TypeStats), Options)]);
+print_int(Device, [#{ '$type' := msacc_data }|_] = Stats, Options) ->
+ io:format(Device, "~s", [print_stats_header(Stats, Options)]),
+ io:format(Device, "~s", [print_stats_type(
+ stats(realtime, Stats), Options)]);
+print_int(Device, [#{ '$type' := msacc_stats, id := _Id }|_] = Stats,Options) ->
+ io:format(Device, "~s", [print_stats_header(Stats, Options)]),
+ io:format(Device, "~s", [print_stats_threads(Stats, Options)]),
+ io:format(Device, "~s", [print_stats_type(
+ msacc:stats(type, Stats), Options)]);
+print_int(Device, [#{ '$type' := msacc_stats }|_] = Stats, Options) ->
+ io:format(Device, "~s", [print_stats_header(Stats, Options)]),
+ io:format(Device, "~s", [print_stats_type(Stats, Options)]).
+
+
+-spec stats() -> msacc_data().
+stats() ->
+ Fun = fun F(K,{PerfCount,StateCount}) ->
+ %% Need to handle ERTS_MSACC_STATE_COUNTERS
+ {F(K,PerfCount),StateCount};
+ F(_K,PerfCount) ->
+ erlang:convert_time_unit(PerfCount, perf_counter, 1000000)
+ end,
+ UsStats = lists:map(
+ fun(#{ counters := Cnt } = M) ->
+ UsCnt = maps:map(Fun,Cnt),
+ M#{ '$type' => msacc_data, counters := UsCnt }
+ end, erlang:statistics(microstate_accounting)),
+ statssort(UsStats).
+
+-spec stats(Analysis, Stats) -> non_neg_integer() when
+ Analysis :: system_realtime | system_runtime,
+ Stats :: msacc_data();
+ (Analysis, Stats) -> msacc_stats() when
+ Analysis :: realtime | runtime,
+ Stats :: msacc_data();
+ (Analysis, StatsOrData) -> msacc_data() | msacc_stats() when
+ Analysis :: type,
+ StatsOrData :: msacc_data() | msacc_stats().
+stats(system_realtime, Stats) ->
+ lists:foldl(fun(#{ counters := Cnt }, Acc) ->
+ get_total(Cnt, Acc)
+ end, 0, Stats);
+stats(system_runtime, Stats) ->
+ lists:foldl(fun(#{ counters := Cnt }, Acc) ->
+ get_total(maps:remove(sleep, Cnt), Acc)
+ end, 0, Stats);
+stats(realtime, Stats) ->
+ RealTime = stats(system_realtime, Stats),
+ statssort([get_thread_perc(Thread, RealTime) || Thread <- Stats]);
+stats(runtime, Stats) ->
+ RunTime = stats(system_runtime, Stats),
+ statssort([get_thread_perc(T#{ counters := maps:remove(sleep,Cnt)}, RunTime)
+ || T = #{ counters := Cnt } <- Stats]);
+stats(type, Stats) ->
+ statssort(merge_threads(Stats, [])).
+
+print_stats_overview(Stats, _Options) ->
+ RunTime = stats(system_runtime, Stats),
+ RealTime = stats(system_realtime, Stats) div length(Stats),
+ SchedStats = [S || #{ type := scheduler } = S <- Stats],
+ AvgSchedRunTime = stats(system_runtime, SchedStats) div length(SchedStats),
+ NumSize = if
+ RealTime > RunTime -> length(integer_to_list(RealTime));
+ true -> length(integer_to_list(RunTime))
+ end,
+ [io_lib:format("Average thread real-time : ~*B us~n",
+ [NumSize, RealTime]),
+ io_lib:format("Accumulated system run-time : ~*B us~n",
+ [NumSize, RunTime]),
+ io_lib:format("Average scheduler run-time : ~*B us~n",
+ [NumSize, AvgSchedRunTime]),
+ io_lib:format("~n",[])].
+
+print_stats_threads(Stats, Options) ->
+ [io_lib:format("~nStats per thread:~n", []),
+ [print_thread_info(Thread, Options) || Thread <- Stats]].
+
+print_stats_type(Stats, Options) ->
+ [io_lib:format("~nStats per type:~n", []),
+ [print_thread_info(Thread, Options) || Thread <- Stats]].
+
+
+print_stats_header([#{ counters := Cnt }|_], #{ system := PrintSys }) ->
+ [io_lib:format("~14s", ["Thread"]),
+ map(fun(Counter, _) when PrintSys->
+ io_lib:format("~9s ", [atom_to_list(Counter)]);
+ (Counter, _) ->
+ io_lib:format("~9s", [atom_to_list(Counter)])
+ end, Cnt),
+ io_lib:format("~n",[])].
+
+print_thread_info(#{ '$type' := msacc_stats,
+ counters := Cnt } = Thread, #{ system := PrintSys }) ->
+ [case maps:find(id, Thread) of
+ error ->
+ io_lib:format("~14s", [atom_to_list(maps:get(type, Thread))]);
+ {ok, Id} ->
+ io_lib:format("~10s(~2B)", [atom_to_list(maps:get(type,Thread)),Id])
+ end,
+ map(fun(_Key, #{ thread := ThreadPerc, system := SystemPerc }) when PrintSys ->
+ io_lib:format("~6.2f%(~4.1f%)", [ThreadPerc, SystemPerc]);
+ (_Key, #{ thread := ThreadPerc }) ->
+ io_lib:format("~8.2f%", [ThreadPerc])
+ end, Cnt),
+ io_lib:format("~n",[])].
+
+get_total(Cnt, Base) ->
+ maps:fold(fun(_, {Val,_}, Time) ->
+ %% Have to handle ERTS_MSACC_STATE_COUNTERS
+ Time + Val;
+ (_, Val, Time) -> Time + Val
+ end, Base, Cnt).
+
+get_thread_perc(#{ '$type' := msacc_data, counters := Cnt } = Thread,
+ SystemTime) ->
+ ThreadTime = get_total(Cnt, 0),
+ Thread#{ '$type' := msacc_stats,
+ system => percentage(ThreadTime,SystemTime),
+ counters => get_thread_perc(Cnt, ThreadTime, SystemTime)}.
+get_thread_perc(Cnt, ThreadTime, SystemTime) ->
+ maps:map(fun F(Key, {Val, C}) ->
+ M = F(Key, Val),
+ M#{ cnt => C };
+ F(_Key, Val) ->
+ #{ thread => percentage(Val, ThreadTime),
+ system => percentage(Val, SystemTime) }
+ end, Cnt).
+
+%% This code is a little bit messy as it has to be able to deal with
+%% both [msacc_data()] and [msacc_stats()].
+merge_threads([#{ '$type' := msacc_stats,
+ type := Type,
+ counters := Cnt } = M0|R], Acc) ->
+ case keyfind(type, Type, Acc) of
+ false ->
+ merge_threads(R, [maps:remove(id,M0#{ threads => 1 })|Acc]);
+ #{ '$type' := msacc_stats, counters := Cnt0,
+ threads := Threads, system := System } = M ->
+ NewMap = M#{ counters := add_counters(Cnt, Cnt0),
+ system := System + maps:get(system, M0),
+ threads := Threads + 1},
+ NewAcc = keyreplace(type, Type, NewMap, Acc),
+ merge_threads(R, NewAcc)
+ end;
+merge_threads([], [#{ '$type' := msacc_stats,
+ system := System,
+ threads := Threads,
+ counters := Cnt} = M0|R]) ->
+ Counters = maps:map(fun(_,#{ thread := Thr } = Map) ->
+ Map#{ thread := Thr / Threads }
+ end, Cnt),
+ M = maps:remove(threads, M0),
+ [M#{ system := System, counters := Counters} | merge_threads([],R)];
+merge_threads([], []) ->
+ [];
+%% The clauses below deal with msacc_data()
+merge_threads([#{ '$type' := msacc_data,
+ type := Type,
+ counters := Cnt } = M0|R], Acc) ->
+ case keyfind(type, Type, Acc) of
+ false ->
+ merge_threads(R, [maps:remove(id,M0)|Acc]);
+ #{ '$type' := msacc_data, counters := Cnt0 } = M ->
+ NewMap = M#{ counters := add_counters(Cnt, Cnt0) },
+ NewAcc = keyreplace(type, Type, NewMap, Acc),
+ merge_threads(R, NewAcc)
+ end;
+merge_threads([], Acc) ->
+ Acc.
+
+add_counters(M1, M2) ->
+ maps:map(
+ fun(Key, #{ thread := Thr1, system := Sys1, cnt := Cnt1}) ->
+ %% Have to handle ERTS_MSACC_STATE_COUNTERS
+ #{ thread := Thr2, system := Sys2, cnt := Cnt2} = maps:get(Key, M2),
+ #{ thread => Thr1 + Thr2, system => Sys1 + Sys2,
+ cnt => Cnt1 + Cnt2 };
+ (Key, #{ thread := Thr1, system := Sys1}) ->
+ #{ thread := Thr2, system := Sys2} = maps:get(Key, M2),
+ #{ thread => Thr1 + Thr2, system => Sys1 + Sys2};
+ (Key, {V1,C1}) ->
+ %% Have to handle ERTS_MSACC_STATE_COUNTERS
+ {V2,C2} = maps:get(Key, M2),{V1+V2,C1+C2};
+ (Key, V1) -> maps:get(Key, M2) + V1
+ end, M1).
+
+percentage(Divident, Divisor) ->
+ if Divisor == 0 andalso Divident /= 0 ->
+ 100.0;
+ Divisor == 0 ->
+ 0.0;
+ true ->
+ Divident / Divisor * 100
+ end.
+
+keyfind(Key, Value, [H|T]) ->
+ case maps:find(Key, H) of
+ {ok, Value} ->
+ H;
+ _ ->
+ keyfind(Key, Value, T)
+ end;
+keyfind(_, _, []) ->
+ false.
+
+keyreplace(Key, Value, NewMap, [H|T]) ->
+ case maps:find(Key, H) of
+ {ok, Value} ->
+ [NewMap|T];
+ _ ->
+ [H|keyreplace(Key, Value, NewMap, T)]
+ end;
+keyreplace(_, _, _, []) ->
+ [].
+
+statssort(Stats) ->
+ lists:sort(fun(#{ type := Type1, id := Id1},
+ #{ type := Type2, id := Id2}) ->
+ {Type1, Id1} < {Type2, Id2};
+ (#{ type := Type1}, #{ type := Type2}) ->
+ Type1 < Type2
+ end, Stats).
+
+map(Fun,Map) ->
+ [ Fun(K,V) || {K,V} <- maps:to_list(Map) ].
diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src
index ad10655aa0..aeda103e72 100644
--- a/lib/runtime_tools/src/runtime_tools.app.src
+++ b/lib/runtime_tools/src/runtime_tools.app.src
@@ -22,7 +22,8 @@
{vsn, "%VSN%"},
{modules, [appmon_info, dbg,observer_backend,percept_profile,
runtime_tools,runtime_tools_sup,erts_alloc_config,
- ttb_autostart,dyntrace,system_information]},
+ ttb_autostart,dyntrace,system_information,
+ msacc]},
{registered, [runtime_tools_sup]},
{applications, [kernel, stdlib]},
{env, []},
diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile
index dcb9082231..432a361468 100644
--- a/lib/runtime_tools/test/Makefile
+++ b/lib/runtime_tools/test/Makefile
@@ -7,7 +7,8 @@ MODULES = \
runtime_tools_SUITE \
system_information_SUITE \
dbg_SUITE \
- erts_alloc_config_SUITE
+ erts_alloc_config_SUITE \
+ msacc_SUITE
ERL_FILES= $(MODULES:%=%.erl)
@@ -26,7 +27,7 @@ RELSYSDIR = $(RELEASE_PATH)/runtime_tools_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl
index 11dd753eed..fd9b8f23bd 100644
--- a/lib/runtime_tools/test/dbg_SUITE.erl
+++ b/lib/runtime_tools/test/dbg_SUITE.erl
@@ -31,7 +31,7 @@
-export([tracee1/1, tracee2/1]).
-export([dummy/0, exported/1]).
--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) ->
diff --git a/lib/runtime_tools/test/dyntrace_SUITE.erl b/lib/runtime_tools/test/dyntrace_SUITE.erl
index 03242784dd..6d39bc54f4 100644
--- a/lib/runtime_tools/test/dyntrace_SUITE.erl
+++ b/lib/runtime_tools/test/dyntrace_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(dyntrace_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]).
diff --git a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl
index 9c0a643e91..a5c4801af9 100644
--- a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl
+++ b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl
@@ -22,7 +22,7 @@
%-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,
diff --git a/lib/runtime_tools/test/msacc_SUITE.erl b/lib/runtime_tools/test/msacc_SUITE.erl
new file mode 100644
index 0000000000..145a6d07fb
--- /dev/null
+++ b/lib/runtime_tools/test/msacc_SUITE.erl
@@ -0,0 +1,132 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2015. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(msacc_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+
+%% Test server callbacks
+-export([suite/0, all/0]).
+
+%% Test cases
+-export([
+ %% API-test
+ api_file/1,
+ api_start_stop/1,
+ api_timer/1,
+ api_print/1
+ ]).
+
+%%--------------------------------------------------------------------
+%% COMMON TEST CALLBACK FUNCTIONS
+%%--------------------------------------------------------------------
+all() ->
+ [
+ api_start_stop,
+ api_file,
+ api_timer,
+ api_print
+ ].
+
+suite() -> [
+ {timetrap,{minutes,1}},
+ {ct_hooks,[ts_install_cth]}
+ ].
+
+%%--------------------------------------------------------------------
+%% TEST CASES
+%%--------------------------------------------------------------------
+
+api_timer(_Config) ->
+
+ %% Run msacc for about 100ms
+ msacc:start(100),
+
+ %% Verify that scheduler 1 executed+slept for about 100ms
+ [Sched1] = [S || S = #{ type := scheduler, id := 1 } <- msacc:stats()],
+
+ #{ counters := Cnt } = Sched1,
+
+ %% Time should be in us
+ Time = maps:fold(fun(_,V,Acc) -> V + Acc end, 0, Cnt),
+
+ if Time < 120000 andalso Time > 80000 -> ok;
+ true -> ct:fail({inaccurate_time, Time, msacc:stats()})
+ end.
+
+%% We just do a basic check that none of the apis crash
+api_start_stop(_Config) ->
+ msacc:start(),
+ timer:sleep(100),
+ msacc:stop(),
+ Runtime = msacc:stats(system_runtime, msacc:stats()),
+ Realtime = msacc:stats(system_realtime, msacc:stats()),
+ true = Runtime < Realtime,
+
+ RuntimeCnt = msacc:stats(runtime, msacc:stats()),
+ RealtimeCnt = msacc:stats(realtime, msacc:stats()),
+ TypeCnt = msacc:stats(type, msacc:stats()),
+
+ %% These should be very similar
+ RuntimeTypeCnt = msacc:stats(type, RuntimeCnt),
+ TypeRuntimeCnt = msacc:stats(runtime, TypeCnt),
+ lists:map(fun({#{ system := T1 },#{ system := T2}}) ->
+ if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok;
+ true -> ct:fail({inaccurate_stats, RuntimeTypeCnt,
+ TypeRuntimeCnt})
+ end
+ end, lists:zip(RuntimeTypeCnt, TypeRuntimeCnt)),
+
+ %% These should be very similar
+ RealtimeTypeCnt = msacc:stats(type, RealtimeCnt),
+ TypeRealtimeCnt = msacc:stats(realtime, TypeCnt),
+ lists:map(fun({#{ system := T1 },#{ system := T2}}) ->
+ if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok;
+ true -> ct:fail({inaccurate_stats, RealtimeTypeCnt,
+ TypeRealtimeCnt})
+ end
+ end,lists:zip(RealtimeTypeCnt, TypeRealtimeCnt)),
+
+ msacc:reset().
+
+api_file(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ File = filename:join(PrivDir, "msacc.stats"),
+ Stats = msacc:stats(),
+ ok = msacc:to_file(File),
+ Stats = msacc:from_file(File),
+
+ PrintFile = filename:join(PrivDir, "msacc.txt"),
+ msacc:print(PrintFile, Stats, #{}).
+
+%% We just check that it is possible to print in a couple of different ways
+api_print(_Config) ->
+ msacc:start(100),
+ io:format("msacc:print(msacc:stats()).~n"),
+ msacc:print(msacc:stats()),
+ io:format("msacc:print(msacc:stats(),#{ system => true }).~n"),
+ msacc:print(msacc:stats(), #{ system => true }),
+ io:format("msacc:print(msacc:stats(runtime,msacc:stats())).~n"),
+ msacc:print(msacc:stats(runtime, msacc:stats())),
+ io:format("msacc:print(msacc:stats(type,msacc:stats())).~n"),
+ msacc:print(msacc:stats(type, msacc:stats())),
+ io:format("msacc:print(msacc:stats(realtime,msacc:stats())).~n"),
+ msacc:print(msacc:stats(realtime, msacc:stats())),
+ io:format("msacc:stats(type,msacc:stats(runtime,msacc:stats())).~n"),
+ msacc:print(msacc:stats(type, msacc:stats(runtime, msacc:stats()))).
diff --git a/lib/runtime_tools/test/runtime_tools_SUITE.erl b/lib/runtime_tools/test/runtime_tools_SUITE.erl
index 7599026e7e..2a79f0a8f9 100644
--- a/lib/runtime_tools/test/runtime_tools_SUITE.erl
+++ b/lib/runtime_tools/test/runtime_tools_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(runtime_tools_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/sasl/doc/src/Makefile b/lib/sasl/doc/src/Makefile
index 1ee48af338..a66b1f8bcb 100644
--- a/lib/sasl/doc/src/Makefile
+++ b/lib/sasl/doc/src/Makefile
@@ -36,7 +36,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
# ----------------------------------------------------
XML_APPLICATION_FILES = ref_man.xml
XML_REF3_FILES = alarm_handler.xml \
- overload.xml \
rb.xml \
release_handler.xml \
systools.xml
diff --git a/lib/sasl/doc/src/overload.xml b/lib/sasl/doc/src/overload.xml
deleted file mode 100644
index 2f19cd9088..0000000000
--- a/lib/sasl/doc/src/overload.xml
+++ /dev/null
@@ -1,152 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1996</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>overload</title>
- <prepared>Peter H&ouml;gfeldt</prepared>
- <responsible>Peter H&ouml;gfeldt</responsible>
- <docno></docno>
- <approved>(Joe Armstrong)</approved>
- <checked></checked>
- <date>1996-10-29</date>
- <rev>A</rev>
- <file>overload.sgml</file>
- </header>
- <module>overload</module>
- <modulesummary>An Overload Regulation Process</modulesummary>
- <description>
- <warning>
- <p>
- All functions in this module are deprecated and will be
- removed in a future release.
- </p>
- </warning>
- <p><c>overload</c> is a process that indirectly regulates the CPU
- usage in the system. The idea is that a main application calls
- function
- <seealso marker="#request/0"><c>request/0</c></seealso>
- before starting a major job and
- proceeds with the job if the return value is positive; otherwise
- the job must not be started.</p>
- <p><c>overload</c> is part of the <c>SASL</c> application and all
- configuration parameters are defined there.</p>
- <p>A set of two intensities are maintained, the <c>total intensity</c>
- and the <c>accept intensity</c>. For that purpose,
- there are two configuration parameters, <c>MaxIntensity</c>
- and <c>Weight</c>; both are measured in 1/second.</p>
- <p>Then total and accept intensities are calculated as
- follows. Assume that the time of the current call to
- <c>request/0</c> is <c>T(n)</c> and that the time of the
- previous call was <c>T(n-1)</c>.</p>
- <list type="bulleted">
- <item>
- <p>The current <c>total intensity</c>, denoted
- <c>TI(n)</c>, is calculated according to the formula</p>
- <p><c>TI(n) = exp(-Weight*(T(n) - T(n-1)) * TI(n-1) + Weight</c>,</p>
- <p>where <c>TI(n-1)</c> is the previous <c>total intensity</c>.</p>
- </item>
- <item>
- <p>The current <c>accept intensity</c>, denoted
- <c>AI(n)</c>, is determined by the formula</p>
- <p><c>AI(n) = exp(-Weight*(T(n) - T(n-1)) * AI(n-1) + Weight</c>,</p>
- <p>where <c>AI(n-1)</c> is the previous <c>accept intensity</c>,
- if the value of <c>exp(-Weight*(T(n) - T(n-1)) * AI(n-1)</c>
- is less than <c>MaxIntensity</c>. Otherwise the value is</p>
- <p><c>AI(n) = exp(-Weight*(T(n) - T(n-1)) * AI(n-1)</c></p>
- </item>
- </list>
- <p>The value of configuration parameter <c>Weight</c> controls the
- speed with which the calculations of intensities react to
- changes in the underlying input intensity. The inverted value of
- <c>Weight</c>, <c>T = 1/Weight</c>, can be thought of as the
- "time constant" of the intensity calculation formulas. For example,
- if <c>Weight = 0.1</c>, a change in the underlying input intensity is
- reflected in <c>total intensity</c> and <c>accept intensity</c> within
- about 10 seconds.</p>
- <p>The overload process defines one alarm, which it sets using
- <c>alarm_handler:set_alarm(Alarm)</c>. <c>Alarm</c> is defined
- as follows:</p>
- <taglist>
- <tag><c>{overload, []}</c></tag>
- <item>
- <p>This alarm is set when the current <c>accept intensity</c> exceeds
- <c>MaxIntensity</c>.</p>
- </item>
- </taglist>
- <p>A new request is not accepted until the current <c>accept
- intensity</c> has fallen below <c>MaxIntensity</c>. To prevent the
- overload process from generating many set/reset alarms, the
- alarm is not reset until the current <c>accept intensity</c> has fallen
- below 75% of <c>MaxIntensity</c>; it is not until then that
- the alarm can be set again.</p>
- </description>
-
- <funcs>
- <func>
- <name>request() -> accept | reject</name>
- <fsummary>Requests to proceed with current job.</fsummary>
- <desc>
- <p>Returns <c>accept</c> or <c>reject</c> depending on the
- current value of the <c>accept intensity</c>.</p>
- <p>The application
- calling this function is to proceed with the job in
- question if the return value is <c>accept</c>; otherwise it
- is not to continue with that job.</p>
- </desc>
- </func>
-
- <func>
- <name>get_overload_info() -> OverloadInfo</name>
- <fsummary>Returns current overload information data.</fsummary>
- <type>
- <v>OverloadInfo = [{total_intensity, TotalIntensity},
- {accept_intensity, AcceptIntensity}, {max_intensity,
- MaxIntensity}, {weight, Weight}, {total_requests,
- TotalRequests}, {accepted_requests, AcceptedRequests}].</v>
- <v>TotalIntensity = float() > 0</v>
- <v>AcceptIntensity = float() > 0</v>
- <v>MaxIntensity = float() > 0</v>
- <v>Weight = float() > 0</v>
- <v>TotalRequests = integer()</v>
- <v>AcceptedRequests = integer()</v>
- </type>
- <desc>
- <p>Returns:</p>
- <list type="bulleted">
- <item>Current total and accept intensities</item>
- <item>Configuration parameters</item>
- <item>Absolute counts of the total number of requests</item>
- <item>Accepted number of requests (since the overload
- process was started)</item>
- </list>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>See Also</title>
- <p><seealso marker="alarm_handler"><c>alarm_handler(3)</c></seealso>,
- <seealso marker="sasl_app"><c>sasl(6)</c></seealso></p>
- </section>
-</erlref>
-
diff --git a/lib/sasl/doc/src/ref_man.xml b/lib/sasl/doc/src/ref_man.xml
index a80e5a2a00..74cd92a9b0 100644
--- a/lib/sasl/doc/src/ref_man.xml
+++ b/lib/sasl/doc/src/ref_man.xml
@@ -35,7 +35,6 @@
</description>
<xi:include href="sasl_app.xml"/>
<xi:include href="alarm_handler.xml"/>
- <xi:include href="overload.xml"/>
<xi:include href="rb.xml"/>
<xi:include href="release_handler.xml"/>
<xi:include href="systools.xml"/>
diff --git a/lib/sasl/doc/src/sasl_app.xml b/lib/sasl/doc/src/sasl_app.xml
index bcd446a868..044c016302 100644
--- a/lib/sasl/doc/src/sasl_app.xml
+++ b/lib/sasl/doc/src/sasl_app.xml
@@ -34,7 +34,6 @@
<p>The <c>SASL</c> application provides the following services:</p>
<list type="bulleted">
<item><c>alarm_handler</c></item>
- <item><c>overload</c> (deprecated)</item>
<item><c>rb</c></item>
<item><c>release_handler</c></item>
<item><c>systools</c></item>
@@ -140,21 +139,6 @@
this parameter is undefined, the <c>log_mf_h</c> handler is
not installed.</p>
</item>
- <tag><c><![CDATA[overload_max_intensity = float() > 0 ]]></c></tag>
- <item>
- <p>Specifies the maximum intensity
- for <seealso marker="overload"><c>overload</c></seealso>. Default
- is <c>0.8</c>.</p>
- <p>Note that the <c>overload</c> module is deprected and
- will be removed in a future release.</p>
- </item>
- <tag><c><![CDATA[overload_weight = float() > 0 ]]></c></tag>
- <item>
- <p>Specifies the <seealso marker="overload"><c>overload</c></seealso>
- weight. Default is <c>0.1</c>.</p>
- <p>Note that the <c>overload</c> module is deprected and
- will be removed in a future release.</p>
- </item>
<tag><c><![CDATA[start_prg = string() ]]></c></tag>
<item>
<p>Specifies the program to be used when restarting the system
@@ -205,7 +189,6 @@
<p><seealso marker="alarm_handler"><c>alarm_handler(3)</c></seealso>,
<seealso marker="kernel:error_logger"><c>error_logger(3)</c></seealso>,
<seealso marker="stdlib:log_mf_h"><c>log_mf_h(3)</c></seealso>,
- <seealso marker="overload"><c>overload(3)</c></seealso>,
<seealso marker="rb"><c>rb(3)</c></seealso>,
<seealso marker="release_handler"><c>release_handler(3)</c></seealso>,
<seealso marker="systools"><c>systools(3)</c></seealso></p>
diff --git a/lib/sasl/doc/src/sasl_intro.xml b/lib/sasl/doc/src/sasl_intro.xml
index bbc9457103..237580977c 100644
--- a/lib/sasl/doc/src/sasl_intro.xml
+++ b/lib/sasl/doc/src/sasl_intro.xml
@@ -36,7 +36,6 @@
<list type="bulleted">
<item>Error logging</item>
<item>Alarm handling</item>
- <item>Overload regulation</item>
<item>Release handling</item>
<item>Report browsing</item>
</list>
diff --git a/lib/sasl/src/Makefile b/lib/sasl/src/Makefile
index 7ff6a03a50..92d4818f2e 100644
--- a/lib/sasl/src/Makefile
+++ b/lib/sasl/src/Makefile
@@ -36,7 +36,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/sasl-$(VSN)
# ----------------------------------------------------
MODULES= alarm_handler sasl sasl_report \
sasl_report_file_h sasl_report_tty_h format_lib_supp \
- misc_supp overload rb rb_format_supp release_handler \
+ misc_supp rb rb_format_supp release_handler \
release_handler_1 si si_sasl_supp systools \
systools_make systools_rc systools_relup systools_lib \
erlsrv
diff --git a/lib/sasl/src/misc_supp.erl b/lib/sasl/src/misc_supp.erl
index 42de7eedec..39656f6e65 100644
--- a/lib/sasl/src/misc_supp.erl
+++ b/lib/sasl/src/misc_supp.erl
@@ -27,7 +27,7 @@
%%% 2) Very generic functions such as, multi_map, is_string...
%%%
%%% This module is a part of the BOS. (format_pdict is called from
-%%% init, memsup, disksup, overload (but not the fileserver since it
+%%% init, memsup, disksup (but not the fileserver since it
%%% formats its pdict its own way).)
%%%---------------------------------------------------------------------
diff --git a/lib/sasl/src/overload.erl b/lib/sasl/src/overload.erl
deleted file mode 100644
index bc8ab7d5e4..0000000000
--- a/lib/sasl/src/overload.erl
+++ /dev/null
@@ -1,233 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(overload).
-
--deprecated(module).
-
--export([start_link/0, request/0, set_config_data/2,
- get_overload_info/0]).
-
--export([init/1, handle_call/3, handle_info/2, terminate/2,
- format_status/2]).
-
-%%%-----------------------------------------------------------------
-%%% This is a rewrite of overload from BS.3, by Peter Högfeldt.
-%%%
-%%% DESCRIPTION
-%%%
-%%% This module implements a server process that keeps record of the
-%%% intensity of calls of the request/0 function, and answers accept or
-%%% reject depending on if the current average intensity is not greater
-%%% than a specified maximum intensity.
-%%%
-%%% The intensity i is calculated according to the formula:
-%%% i(n) = exp(-K*(T(n) - T(n-1)))*i(n-1) + Kappa
-%%% where i(n) is the intensity at event n, Kappa is a constant, and
-%%% T(n) is the time at event n.
-%%%
-%%% The constant Kappa can be thought of as 1 / T, where T is the time
-%%% constant. Kappa is externally referred to as Weight.
-%%%
-%%% We keep track of two intensities: the total call intensity and the
-%%% intensity of accepted calls.
-%%%-----------------------------------------------------------------
-%%% TODO
-%%%
-%%% 3. Hysteresis.
-%%%
-%%%-----------------------------------------------------------------
-
--record(state, {total = 0, accept = 0, max, prev_t = get_now(),
- kappa, call_counts = {0, 0}, alarm = clear}).
-
--define(clear_timeout, 30000).
-
-start_link() ->
- gen_server:start_link({local, overload}, overload, [], []).
-
-init([]) ->
- process_flag(priority, high),
- MaxIntensity = fetch_config_data(overload_max_intensity),
- Kappa = fetch_config_data(overload_weight),
- {ok, #state{max = MaxIntensity, kappa = Kappa}}.
-
-%%-----------------------------------------------------------------
-%% Func: request/0
-%% Purpose: This is a request to proceed, e.g. a request to
-%% establish a call.
-%% Returns: accept | reject
-%%-----------------------------------------------------------------
-request() -> call(request).
-
-%%-----------------------------------------------------------------
-%% Func: set_config_data/2
-%% Purpose: Set configuration data, and reset intensities.
-%% Arguments: MaxIntensity (real > 0), Weight (real > 0).
-%% Returns: ok | {error, What}
-%% This function is for debugging purposes and is therefore not
-%% documented at all.
-%%-----------------------------------------------------------------
-set_config_data(MaxIntensity, Weight) ->
- call({set_config_data, MaxIntensity, Weight}).
-%%-----------------------------------------------------------------
-%% Func: get_overload_info/0
-%% Returns: A list of tagged items: TotalIntensity, AcceptIntensity,
-%% MaxIntensity, Weight, TotalRequests, AcceptedRequests.
-%%-----------------------------------------------------------------
-get_overload_info() -> call(get_overload_info).
-
-%%-----------------------------------------------------------------
-%% call(Request) -> Term
-%%-----------------------------------------------------------------
-call(Req) ->
- gen_server:call(overload, Req, infinity).
-
-%%%-----------------------------------------------------------------
-%%% Callback functions from gen_server
-%%%-----------------------------------------------------------------
-handle_call(request, _From, State) ->
- #state{total = TI, accept = AI, kappa = Kappa, prev_t = PrevT,
- alarm = Alarm} = State,
- {TR, AR} = State#state.call_counts,
- T = get_now(),
- CurI = new_intensity(AI, T, PrevT, Kappa),
- NewTI = new_intensity(TI, T, PrevT, Kappa) + Kappa,
- if
- CurI =< State#state.max ->
- %% Hysteresis: If alarm is set, and current intensity has
- %% fallen below 75% of max intensity, clear alarm.
- NewAlarm = if
- CurI =< 0.75*State#state.max ->
- clear_alarm(Alarm);
- true ->
- Alarm
- end,
- {reply, accept, State#state{call_counts = {TR+1, AR+1},
- prev_t = T, total = NewTI,
- accept = CurI + Kappa,
- alarm = NewAlarm},
- ?clear_timeout};
- true ->
- %% Set alarm if not already set.
- NewAlarm = set_alarm(Alarm),
- {reply, reject,
- State#state{call_counts = {TR+1, AR}, prev_t = T,
- total = NewTI, accept = CurI,
- alarm = NewAlarm},
- ?clear_timeout}
- end;
-handle_call({set_config_data, MaxIntensity, Weight}, _From, _State) ->
- {reply, ok, #state{max = MaxIntensity, kappa = Weight},
- ?clear_timeout};
-handle_call(get_overload_info, _From, State) ->
- #state{max = MI, total = TI, accept = AI, kappa = Kappa,
- prev_t = PrevT, call_counts = {TR, AR}} = State,
- T = get_now(),
- CurI = new_intensity(AI, T, PrevT, Kappa),
- NewTI = new_intensity(TI, T, PrevT, Kappa),
- Reply = [{total_intensity, NewTI}, {accept_intensity, CurI},
- {max_intensity, MI}, {weight, Kappa},
- {total_requests, TR}, {accepted_requests, AR}],
- {reply, Reply, State#state{total = NewTI, accept = CurI},
- ?clear_timeout}.
-
-handle_info(timeout, State) ->
- #state{total = TI, accept = AI, kappa = Kappa, prev_t = PrevT,
- alarm = Alarm} = State,
- T = get_now(),
- CurI = new_intensity(AI, T, PrevT, Kappa),
- NewTI = new_intensity(TI, T, PrevT, Kappa),
- if
- CurI < 0.75* State#state.max ->
- NewAlarm = clear_alarm(Alarm),
- {noreply, State#state{total = NewTI, accept = CurI,
- alarm = NewAlarm}};
-
- true ->
- {noreply, State#state{total = NewTI, accept = CurI},
- ?clear_timeout}
- end;
-
-handle_info(_, State) ->
- {noreply, State, ?clear_timeout}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-fetch_config_data(Tag) ->
- case application:get_env(sasl, Tag) of
- {ok, Value} -> Value;
- _ -> fetch_default_data(Tag)
- end.
-
-fetch_default_data(overload_max_intensity) -> 0.8;
-fetch_default_data(overload_weight) -> 0.1.
-
-set_alarm(clear) ->
- alarm_handler:set_alarm({overload, []}),
- set;
-set_alarm(Alarm) ->
- Alarm.
-
-clear_alarm(set) ->
- alarm_handler:clear_alarm(overload),
- clear;
-clear_alarm(Alarm) ->
- Alarm.
-
-%%-----------------------------------------------------------------
-%% The catch protects against floating-point exception.
-%%
-new_intensity(I, T, PrevT, K) ->
- Diff = sub(T, PrevT)/1000,
- case catch (I*math:exp(-K*Diff)) of
- {'EXIT', _} -> % Assume zero.
- 0.0;
- Res ->
- Res
- end.
-
-%% Mask equal to 2^27 - 1, used below.
--define(mask27, 16#7ffffff).
-
-%% Returns number of milliseconds in the range [0, 2^27 - 1]. Must have
-%% this since statistics(wall_clock) wraps. Having 2^27 -1 as the max
-%% assures that we always get non-negative integers. 2^27 milliseconds
-%% are approx. 37.28 hours.
-get_now() ->
- element(1, statistics(wall_clock)) band ?mask27.
-
-%% Returns (X - Y) mod 2^27 (which is in the range [0, 2^27 - 1]).
-sub(X, Y) ->
- (X + (bnot Y) + 1) band ?mask27.
-
-format_status(Opt, [PDict, #state{max = MI, total = TI, accept = AI,
- kappa = K,
- call_counts = {TR, AR}}]) ->
- [{data, [{"Total Intensity", TI},
- {"Accept Intensity", AI},
- {"Max Intensity", MI},
- {"Weight", K},
- {"Total requests", TR},
- {"Accepted requests", AR}]} |
- misc_supp:format_pdict(Opt, PDict, [])].
diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src
index 507e2dc229..16e8e44ba2 100644
--- a/lib/sasl/src/sasl.app.src
+++ b/lib/sasl/src/sasl.app.src
@@ -24,7 +24,6 @@
alarm_handler,
format_lib_supp,
misc_supp,
- overload,
rb,
rb_format_supp,
release_handler,
@@ -41,7 +40,7 @@
systools_relup,
systools_lib
]},
- {registered, [sasl_sup, alarm_handler, overload, release_handler]},
+ {registered, [sasl_sup, alarm_handler, release_handler]},
{applications, [kernel, stdlib]},
{env, [{sasl_error_logger, tty},
{errlog_type, all}]},
diff --git a/lib/sasl/src/sasl.erl b/lib/sasl/src/sasl.erl
index fc49fc2465..0fb85682c6 100644
--- a/lib/sasl/src/sasl.erl
+++ b/lib/sasl/src/sasl.erl
@@ -170,7 +170,4 @@ init(safe) ->
AlarmH = {alarm_handler,
{alarm_handler, start_link, []},
permanent, 2000, worker, dynamic},
- Overload = {overload,
- {overload, start_link, []},
- permanent, 2000, worker, [overload]},
- {ok, {SupFlags, [AlarmH, Overload]}}.
+ {ok, {SupFlags, [AlarmH]}}.
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index 8132034172..d207dc15bb 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -1469,7 +1469,9 @@ mandatory_modules() ->
preloaded() ->
%% Sorted
- [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_eval,prim_file,
+ [erl_prim_loader,erlang,
+ erts_code_purger,
+ erts_internal,init,otp_ring0,prim_eval,prim_file,
prim_inet,prim_zip,zlib].
%%______________________________________________________________________
diff --git a/lib/sasl/test/Makefile b/lib/sasl/test/Makefile
index 86976def6a..2e9e107efd 100644
--- a/lib/sasl/test/Makefile
+++ b/lib/sasl/test/Makefile
@@ -33,7 +33,6 @@ MODULES= \
sasl_report_suite_supervisor \
systools_SUITE \
systools_rc_SUITE \
- overload_SUITE \
rb_SUITE \
rh_test_lib \
@@ -55,8 +54,7 @@ RELSYSDIR = $(RELEASE_PATH)/sasl_test
# FLAGS
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \
- -I$(ERL_TOP)/lib/sasl/src
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/sasl/src
EBIN = .
diff --git a/lib/sasl/test/overload_SUITE.erl b/lib/sasl/test/overload_SUITE.erl
deleted file mode 100644
index 02d1056698..0000000000
--- a/lib/sasl/test/overload_SUITE.erl
+++ /dev/null
@@ -1,168 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2011. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
--module(overload_SUITE).
--include_lib("common_test/include/ct.hrl").
-
--compile(export_all).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all() -> [info, set_config_data, set_env_vars, request, timeout].
-
-init_per_testcase(_Case,Config) ->
- restart_sasl(),
- Config.
-
-end_per_testcase(Case,Config) ->
- try apply(?MODULE,Case,[cleanup,Config])
- catch error:undef -> ok
- end,
- ok.
-
-%%%-----------------------------------------------------------------
-info(_Config) ->
- Info = overload:get_overload_info(),
- [{total_intensity,0.0},
- {accept_intensity,0.0},
- {max_intensity,0.8},
- {weight,0.1},
- {total_requests,0},
- {accepted_requests,0}] = Info.
-
-%%%-----------------------------------------------------------------
-set_config_data(_Config) ->
- InfoDefault = overload:get_overload_info(),
- ok = check_info(0.8,0.1,InfoDefault),
- ok = overload:set_config_data(0.5,0.4),
- Info1 = overload:get_overload_info(),
- ok = check_info(0.5,0.4,Info1),
- ok.
-
-%%%-----------------------------------------------------------------
-set_env_vars(_Config) ->
- InfoDefault = overload:get_overload_info(),
- ok = check_info(0.8,0.1,InfoDefault),
- ok = application:set_env(sasl,overload_max_intensity,0.5),
- ok = application:set_env(sasl,overload_weight,0.4),
- ok = application:stop(sasl),
- ok = application:start(sasl),
- Info1 = overload:get_overload_info(),
- ok = check_info(0.5,0.4,Info1),
- ok.
-set_env_vars(cleanup,_Config) ->
- application:unset_env(sasl,overload_max_intensity),
- application:unset_env(sasl,overload_weight),
- ok.
-
-%%%-----------------------------------------------------------------
-request(_Config) ->
- %% Find number of request that can be done with default settings
- %% and no delay
- overload:set_config_data(0.8, 0.1),
- NDefault = do_many_requests(0),
- restart_sasl(),
- ?t:format("NDefault: ~p",[NDefault]),
-
- %% Check that the number of requests increases when max_intensity
- %% increases
- overload:set_config_data(2, 0.1),
- NLargeMI = do_many_requests(0),
- restart_sasl(),
- ?t:format("NLargeMI: ~p",[NLargeMI]),
- true = NLargeMI > NDefault,
-
- %% Check that the number of requests decreases when weight
- %% increases
- overload:set_config_data(0.8, 1),
- NLargeWeight = do_many_requests(0),
- restart_sasl(),
- ?t:format("NLargeWeight: ~p",[NLargeWeight]),
- true = NLargeWeight < NDefault,
-
- %% Check that number of requests increases when delay between
- %% requests increases.
- %% (Keeping same config and comparing to large weight in order to
- %% minimize the time needed for this case.)
- overload:set_config_data(0.8, 1),
- NLargeTime = do_many_requests(500),
- restart_sasl(),
- ?t:format("NLargeTime: ~p",[NLargeTime]),
- true = NLargeTime > NLargeWeight,
- ok.
-
-%%%-----------------------------------------------------------------
-timeout(_Config) ->
- overload:set_config_data(0.8, 1),
- _N = do_many_requests(0),
-
- %% Check that the overload alarm is raised
- [{overload,_}] = alarm_handler:get_alarms(),
-
- %% Fake a clear timeout in overload.erl and check that, since it
- %% came very soon after the overload situation, the alarm is not
- %% cleared
- overload ! timeout,
- timer:sleep(1000),
- [{overload,_}] = alarm_handler:get_alarms(),
-
- %% A bit later, try again and check that this time the alarm is
- %% cleared
- overload ! timeout,
- timer:sleep(1000),
- [] = alarm_handler:get_alarms(),
-
- ok.
-
-
-%%%-----------------------------------------------------------------
-%%% INTERNAL FUNCTIONS
-
-%%%-----------------------------------------------------------------
-%%% Call overload:request/0 up to 30 times with the given time delay
-%%% between. Stop when 'reject' is returned.
-do_many_requests(T) ->
- 30 - do_requests(30,T).
-
-do_requests(0,_) ->
- ?t:fail(never_rejected);
-do_requests(N,T) ->
- case overload:request() of
- accept ->
- timer:sleep(T),
- do_requests(N-1,T);
- reject ->
- N
- end.
-
-%%%-----------------------------------------------------------------
-%%% Restart the sasl application
-restart_sasl() ->
- application:stop(sasl),
- application:start(sasl),
- ok.
-
-%%%-----------------------------------------------------------------
-%%% Check that max_intensity and weight is set as expected
-check_info(MI,W,Info) ->
- case {lists:keyfind(max_intensity,1,Info), lists:keyfind(weight,1,Info)} of
- {{_,MI},{_,W}} -> ok;
- _ -> ?t:fail({unexpected_info,MI,W,Info})
- end.
diff --git a/lib/sasl/test/sasl_report_SUITE.erl b/lib/sasl/test/sasl_report_SUITE.erl
index 940234f152..7469ec4d46 100644
--- a/lib/sasl/test/sasl_report_SUITE.erl
+++ b/lib/sasl/test/sasl_report_SUITE.erl
@@ -24,7 +24,7 @@
-export([crash_me/0,start_link/0,init/1,handle_cast/2,terminate/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl
index cf0ed5fcfc..825a7f6e86 100644
--- a/lib/sasl/test/systools_SUITE.erl
+++ b/lib/sasl/test/systools_SUITE.erl
@@ -1640,25 +1640,21 @@ app_start_type_relup(Dir2,Name2,Config) ->
%% ?t:format("Dn: ~p",[DownInstructions]),
[{load_object_code, {mnesia, _, _}},
{load_object_code, {runtime_tools, _, _}},
- {load_object_code, {webtool, _, _}},
{load_object_code, {snmp, _, _}},
{load_object_code, {xmerl, _, _}},
point_of_no_return
| UpInstructionsT] = UpInstructions,
true = lists:member({apply,{application,start,[mnesia,permanent]}}, UpInstructionsT),
true = lists:member({apply,{application,start,[runtime_tools,transient]}}, UpInstructionsT),
- true = lists:member({apply,{application,start,[webtool,temporary]}}, UpInstructionsT),
true = lists:member({apply,{application,load,[snmp]}}, UpInstructionsT),
false = lists:any(fun({apply,{application,_,[xmerl|_]}}) -> true; (_) -> false end, UpInstructionsT),
[point_of_no_return | DownInstructionsT] = DownInstructions,
true = lists:member({apply,{application,stop,[mnesia]}}, DownInstructionsT),
true = lists:member({apply,{application,stop,[runtime_tools]}}, DownInstructionsT),
- true = lists:member({apply,{application,stop,[webtool]}}, DownInstructionsT),
true = lists:member({apply,{application,stop,[snmp]}}, DownInstructionsT),
true = lists:member({apply,{application,stop,[xmerl]}}, DownInstructionsT),
true = lists:member({apply,{application,unload,[mnesia]}}, DownInstructionsT),
true = lists:member({apply,{application,unload,[runtime_tools]}}, DownInstructionsT),
- true = lists:member({apply,{application,unload,[webtool]}}, DownInstructionsT),
true = lists:member({apply,{application,unload,[snmp]}}, DownInstructionsT),
true = lists:member({apply,{application,unload,[xmerl]}}, DownInstructionsT),
ok.
@@ -2207,7 +2203,6 @@ create_script(latest_app_start_type1,Config) ->
create_script(latest_app_start_type2,Config) ->
OtherApps = [{mnesia,current,permanent},
{runtime_tools,current,transient},
- {webtool,current,temporary},
{snmp,current,load},
{xmerl,current,none}],
Apps = core_apps(current) ++ OtherApps,
diff --git a/lib/sasl/test/systools_rc_SUITE.erl b/lib/sasl/test/systools_rc_SUITE.erl
index 3754ed99f2..2ecb6f107a 100644
--- a/lib/sasl/test/systools_rc_SUITE.erl
+++ b/lib/sasl/test/systools_rc_SUITE.erl
@@ -26,10 +26,6 @@
translate_emulator_restarts/1,
translate_add_delete_module/1]).
-%%-----------------------------------------------------------------
-%% erl -compile systools_rc_SUITE @i ../src/ @i ../../test_server/include/
-%% c(systools_rc_SUITE, [{i, "../src"}, {i, "../../test_server/include"}]).
-%%-----------------------------------------------------------------
all() ->
[syntax_check, translate, translate_app, translate_emulator_restarts,
translate_add_delete_module].
diff --git a/lib/snmp/test/Makefile b/lib/snmp/test/Makefile
index 3261982a32..8e895bc5b1 100644
--- a/lib/snmp/test/Makefile
+++ b/lib/snmp/test/Makefile
@@ -150,7 +150,6 @@ ERL_COMPILE_FLAGS += -I../../snmp/src/app \
-I../../snmp/src/misc \
-I../../snmp/src/agent \
-I../../snmp/src/manager \
- -I$(ERL_TOP)/lib/test_server/include \
-I../../snmp/include \
-Dsnmp_test_data=snmp_test_data \
-Dversion=\"$(VSN)$(PRE_VSN)\" \
diff --git a/lib/snmp/test/exp/snmp_agent_ms_test.erl b/lib/snmp/test/exp/snmp_agent_ms_test.erl
index 3415fcc8e6..3010de0619 100644
--- a/lib/snmp/test/exp/snmp_agent_ms_test.erl
+++ b/lib/snmp/test/exp/snmp_agent_ms_test.erl
@@ -29,7 +29,7 @@
-define(application, snmp).
-include_lib("kernel/include/file.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-define(SNMP_USE_V3, true).
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/snmp/test/exp/snmp_agent_mt_test.erl b/lib/snmp/test/exp/snmp_agent_mt_test.erl
index 89815e1044..71ae58baca 100644
--- a/lib/snmp/test/exp/snmp_agent_mt_test.erl
+++ b/lib/snmp/test/exp/snmp_agent_mt_test.erl
@@ -29,7 +29,7 @@
-define(application, snmp).
-include_lib("kernel/include/file.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-define(SNMP_USE_V3, true).
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/snmp/test/exp/snmp_agent_v1_test.erl b/lib/snmp/test/exp/snmp_agent_v1_test.erl
index ec243747df..55045d536e 100644
--- a/lib/snmp/test/exp/snmp_agent_v1_test.erl
+++ b/lib/snmp/test/exp/snmp_agent_v1_test.erl
@@ -29,7 +29,7 @@
-define(application, snmp).
-include_lib("kernel/include/file.hrl").
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-define(SNMP_USE_V3, true).
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/snmp/test/exp/snmp_agent_v2_test.erl b/lib/snmp/test/exp/snmp_agent_v2_test.erl
index ce95d0b5cd..6238a6c4bd 100644
--- a/lib/snmp/test/exp/snmp_agent_v2_test.erl
+++ b/lib/snmp/test/exp/snmp_agent_v2_test.erl
@@ -29,7 +29,7 @@
-define(application, snmp).
-include_lib("kernel/include/file.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-define(SNMP_USE_V3, true).
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/snmp/test/exp/snmp_agent_v3_test.erl b/lib/snmp/test/exp/snmp_agent_v3_test.erl
index 1ba06209b2..af7cee9b96 100644
--- a/lib/snmp/test/exp/snmp_agent_v3_test.erl
+++ b/lib/snmp/test/exp/snmp_agent_v3_test.erl
@@ -29,7 +29,7 @@
-define(application, snmp).
-include_lib("kernel/include/file.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-define(SNMP_USE_V3, true).
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/snmp/test/snmp_agent_mibs_test.erl b/lib/snmp/test/snmp_agent_mibs_test.erl
index a03c2b8534..2cbba14c74 100644
--- a/lib/snmp/test/snmp_agent_mibs_test.erl
+++ b/lib/snmp/test/snmp_agent_mibs_test.erl
@@ -31,7 +31,7 @@
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-include_lib("snmp/include/snmp_types.hrl").
-include_lib("snmp/include/SNMP-COMMUNITY-MIB.hrl").
diff --git a/lib/snmp/test/snmp_agent_nfilter_test.erl b/lib/snmp/test/snmp_agent_nfilter_test.erl
index 16a9903198..8aeef81333 100644
--- a/lib/snmp/test/snmp_agent_nfilter_test.erl
+++ b/lib/snmp/test/snmp_agent_nfilter_test.erl
@@ -26,7 +26,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl
index 412d62c6a1..93968ede2e 100644
--- a/lib/snmp/test/snmp_agent_test.erl
+++ b/lib/snmp/test/snmp_agent_test.erl
@@ -421,7 +421,7 @@
-define(application, snmp).
-include_lib("kernel/include/file.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-define(SNMP_USE_V3, true).
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl
index 8ea7b2e081..6f20254fcb 100644
--- a/lib/snmp/test/snmp_agent_test_lib.erl
+++ b/lib/snmp/test/snmp_agent_test_lib.erl
@@ -69,7 +69,7 @@
-export([wait/5, run/4]).
-include_lib("kernel/include/file.hrl").
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-define(SNMP_USE_V3, true).
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/snmp/test/snmp_app_test.erl b/lib/snmp/test/snmp_app_test.erl
index 3b5b196ad6..6892d4aa93 100644
--- a/lib/snmp/test/snmp_app_test.erl
+++ b/lib/snmp/test/snmp_app_test.erl
@@ -45,7 +45,7 @@
-include_lib("kernel/include/file.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl
index c83c4e0fed..b08181191f 100644
--- a/lib/snmp/test/snmp_compiler_test.erl
+++ b/lib/snmp/test/snmp_compiler_test.erl
@@ -29,7 +29,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/snmp/test/snmp_conf_test.erl b/lib/snmp/test/snmp_conf_test.erl
index 1d514cd1d2..73b471b107 100644
--- a/lib/snmp/test/snmp_conf_test.erl
+++ b/lib/snmp/test/snmp_conf_test.erl
@@ -27,7 +27,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-include_lib("snmp/include/STANDARD-MIB.hrl").
diff --git a/lib/snmp/test/snmp_log_test.erl b/lib/snmp/test/snmp_log_test.erl
index b204522ee0..ae2581fb69 100644
--- a/lib/snmp/test/snmp_log_test.erl
+++ b/lib/snmp/test/snmp_log_test.erl
@@ -30,7 +30,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-define(SNMP_USE_V3, true).
-include_lib("snmp/include/snmp_types.hrl").
diff --git a/lib/snmp/test/snmp_manager_config_test.erl b/lib/snmp/test/snmp_manager_config_test.erl
index 47e150e8e8..8428b61e8a 100644
--- a/lib/snmp/test/snmp_manager_config_test.erl
+++ b/lib/snmp/test/snmp_manager_config_test.erl
@@ -32,7 +32,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-include_lib("snmp/src/manager/snmpm_usm.hrl").
diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl
index 3d05e5791f..a343dfdca7 100644
--- a/lib/snmp/test/snmp_manager_test.erl
+++ b/lib/snmp/test/snmp_manager_test.erl
@@ -32,7 +32,7 @@
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
-include("snmp_test_data/Test2.hrl").
diff --git a/lib/snmp/test/snmp_manager_user.erl b/lib/snmp/test/snmp_manager_user.erl
index 256ea6a834..55b1e23b2e 100644
--- a/lib/snmp/test/snmp_manager_user.erl
+++ b/lib/snmp/test/snmp_manager_user.erl
@@ -31,7 +31,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
diff --git a/lib/snmp/test/snmp_manager_user_old.erl b/lib/snmp/test/snmp_manager_user_old.erl
index 0f0f026eca..f317fa831c 100644
--- a/lib/snmp/test/snmp_manager_user_old.erl
+++ b/lib/snmp/test/snmp_manager_user_old.erl
@@ -30,7 +30,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
diff --git a/lib/snmp/test/snmp_manager_user_test.erl b/lib/snmp/test/snmp_manager_user_test.erl
index a0cdcdef4d..64edfef4d5 100644
--- a/lib/snmp/test/snmp_manager_user_test.erl
+++ b/lib/snmp/test/snmp_manager_user_test.erl
@@ -27,7 +27,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
diff --git a/lib/snmp/test/snmp_manager_user_test_lib.erl b/lib/snmp/test/snmp_manager_user_test_lib.erl
index a547f78efb..ea2c83a0da 100644
--- a/lib/snmp/test/snmp_manager_user_test_lib.erl
+++ b/lib/snmp/test/snmp_manager_user_test_lib.erl
@@ -30,7 +30,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("snmp_test_lib.hrl").
diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl
index 4da3a6018b..101bf76cd3 100644
--- a/lib/ssh/src/ssh_bits.erl
+++ b/lib/ssh/src/ssh_bits.erl
@@ -26,52 +26,30 @@
-include("ssh.hrl").
--export([encode/2]).
--export([mpint/1, string/1, name_list/1]).
+-export([mpint/1, name_list/1]).
-export([random/1]).
--define(name_list(X),
- (fun(B) -> ?binary(B) end)(list_to_binary(name_concat(X)))).
-
-
-name_concat([Name]) when is_atom(Name) -> atom_to_list(Name);
-name_concat([Name]) when is_list(Name) -> Name;
-name_concat([Name|Ns]) ->
- if is_atom(Name) ->
- [atom_to_list(Name),"," | name_concat(Ns)];
- is_list(Name) ->
- [Name,"," | name_concat(Ns)]
- end;
-name_concat([]) -> [].
-
-
-name_list(Ns) ->
- ?name_list(Ns).
+%%%----------------------------------------------------------------
+name_list([Name]) -> to_bin(Name);
+name_list([Name|Ns]) -> <<(to_bin(Name))/binary, ",", (name_list(Ns))/binary>>;
+name_list([]) -> <<>>.
+
+to_bin(A) when is_atom(A) -> list_to_binary(atom_to_list(A));
+to_bin(S) when is_list(S) -> list_to_binary(S);
+to_bin(B) when is_binary(B) -> B.
+
+%%%----------------------------------------------------------------
+%%% Multi Precision Integer encoding
+mpint(-1) -> <<0,0,0,1,16#ff>>;
+mpint(0) -> <<0,0,0,0>>;
+mpint(X) when X < 0 -> mpint_neg(X,0,[]);
+mpint(X) -> mpint_pos(X,0,[]).
-
-string(Str) ->
- ?string(Str).
-
-
-%% MP representaion (SSH2)
-mpint(X) when X < 0 ->
- if X == -1 ->
- <<0,0,0,1,16#ff>>;
- true ->
- mpint_neg(X,0,[])
- end;
-mpint(X) ->
- if X == 0 ->
- <<0,0,0,0>>;
- true ->
- mpint_pos(X,0,[])
- end.
-
mpint_neg(-1,I,Ds=[MSB|_]) ->
if MSB band 16#80 =/= 16#80 ->
<<?UINT32((I+1)), (list_to_binary([255|Ds]))/binary>>;
true ->
- (<<?UINT32(I), (list_to_binary(Ds))/binary>>)
+ <<?UINT32(I), (list_to_binary(Ds))/binary>>
end;
mpint_neg(X,I,Ds) ->
mpint_neg(X bsr 8,I+1,[(X band 255)|Ds]).
@@ -80,96 +58,17 @@ mpint_pos(0,I,Ds=[MSB|_]) ->
if MSB band 16#80 == 16#80 ->
<<?UINT32((I+1)), (list_to_binary([0|Ds]))/binary>>;
true ->
- (<<?UINT32(I), (list_to_binary(Ds))/binary>>)
+ <<?UINT32(I), (list_to_binary(Ds))/binary>>
end;
mpint_pos(X,I,Ds) ->
mpint_pos(X bsr 8,I+1,[(X band 255)|Ds]).
-encode(List, Types) ->
- list_to_binary(enc(List, Types)).
-
-%%
-%% Encode record element
-%%
-enc(Xs, Ts) ->
- enc(Xs, Ts, 0).
-
-enc(Xs, [boolean|Ts], Offset) ->
- X = hd(Xs),
- [?boolean(X) | enc(tl(Xs), Ts, Offset+1)];
-enc(Xs, [byte|Ts], Offset) ->
- X = hd(Xs),
- [?byte(X) | enc(tl(Xs), Ts,Offset+1)];
-enc(Xs, [uint16|Ts], Offset) ->
- X = hd(Xs),
- [?uint16(X) | enc(tl(Xs), Ts,Offset+2)];
-enc(Xs, [uint32 |Ts], Offset) ->
- X = hd(Xs),
- [?uint32(X) | enc(tl(Xs), Ts,Offset+4)];
-enc(Xs, [uint64|Ts], Offset) ->
- X = hd(Xs),
- [?uint64(X) | enc(tl(Xs), Ts,Offset+8)];
-enc(Xs, [mpint|Ts], Offset) ->
- Y = mpint(hd(Xs)),
- [Y | enc(tl(Xs), Ts,Offset+size(Y))];
-enc(Xs, [string|Ts], Offset) ->
- X0 = hd(Xs),
- Y = ?string(X0),
- [Y | enc(tl(Xs),Ts,Offset+size(Y))];
-enc(Xs, [string_utf8|Ts], Offset) ->
- X0 = hd(Xs),
- Y = ?string_utf8(X0),
- [Y | enc(tl(Xs),Ts,Offset+size(Y))];
-enc(Xs, [binary|Ts], Offset) ->
- X0 = hd(Xs),
- Y = ?binary(X0),
- [Y | enc(tl(Xs), Ts,Offset+size(Y))];
-enc(Xs, [name_list|Ts], Offset) ->
- X0 = hd(Xs),
- Y = ?name_list(X0),
- [Y | enc(tl(Xs), Ts, Offset+size(Y))];
-enc(Xs, [cookie|Ts], Offset) ->
- [random(16) | enc(tl(Xs), Ts, Offset+16)];
-enc(Xs, [{pad,N}|Ts], Offset) ->
- K = (N - (Offset rem N)) rem N,
- [fill_bits(K,0) | enc(Xs, Ts, Offset+K)];
-enc(Xs, ['...'| []], _Offset) ->
- X = hd(Xs),
- if is_binary(X) ->
- [X];
- is_list(X) ->
- [list_to_binary(X)];
- X==undefined ->
- []
- end;
-enc([], [],_) ->
- [].
-
-
-%%
-%% Create a binary with constant bytes
-%%
-fill_bits(N,C) ->
- list_to_binary(fill(N,C)).
-
-fill(0,_C) -> [];
-fill(1,C) -> [C];
-fill(N,C) ->
- Cs = fill(N div 2, C),
- Cs1 = [Cs,Cs],
- if N band 1 == 0 ->
- Cs1;
- true ->
- [C,Cs,Cs]
- end.
-
-
+%%%----------------------------------------------------------------
%% random/1
%% Generate N random bytes
%%
-random(N) ->
- crypto:strong_rand_bytes(N).
+random(N) -> crypto:strong_rand_bytes(N).
diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl
index 9f9f3de8fa..0c9ddad641 100644
--- a/lib/ssh/src/ssh_connect.hrl
+++ b/lib/ssh/src/ssh_connect.hrl
@@ -24,8 +24,9 @@
-type channel_id() :: integer().
--define(DEFAULT_PACKET_SIZE, 32768).
--define(DEFAULT_WINDOW_SIZE, 2*?DEFAULT_PACKET_SIZE).
+-define(DEFAULT_PACKET_SIZE, 65536).
+-define(DEFAULT_WINDOW_SIZE, 10*?DEFAULT_PACKET_SIZE).
+
-define(DEFAULT_TIMEOUT, 5000).
-define(MAX_PROTO_VERSION, 255).
diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl
index b6c4496be2..a0e9a4961c 100644
--- a/lib/ssh/src/ssh_message.erl
+++ b/lib/ssh/src/ssh_message.erl
@@ -32,16 +32,44 @@
-export([encode/1, decode/1, decode_keyboard_interactive_prompts/2]).
+-define('2bin'(X), (if is_binary(X) -> X;
+ is_list(X) -> list_to_binary(X);
+ X==undefined -> <<>>
+ end) ).
+
+-define('E...'(X), ?'2bin'(X)/binary ).
+-define(Eboolean(X), ?BOOLEAN(case X of
+ true -> ?TRUE;
+ false -> ?FALSE
+ end) ).
+-define(Ebyte(X), ?BYTE(X) ).
+-define(Euint32(X), ?UINT32(X) ).
+-define(Estring(X), ?STRING(?'2bin'(X)) ).
+-define(Estring_utf8(X), ?string_utf8(X)/binary ).
+-define(Ename_list(X), ?STRING(ssh_bits:name_list(X)) ).
+-define(Empint(X), (ssh_bits:mpint(X))/binary ).
+-define(Ebinary(X), ?STRING(X) ).
+
+%% encode(Msg) ->
+%% try encode1(Msg)
+%% catch
+%% C:E ->
+%% io:format('***********************~n~p:~p ~p~n',[C,E,Msg]),
+%% error(E)
+%% end.
+
encode(#ssh_msg_global_request{
name = Name,
want_reply = Bool,
data = Data}) ->
- ssh_bits:encode([?SSH_MSG_GLOBAL_REQUEST,
- Name, Bool, Data], [byte, string, boolean, '...']);
+ <<?Ebyte(?SSH_MSG_GLOBAL_REQUEST), ?Estring(Name), ?Eboolean(Bool), ?'E...'(Data)>>;
+
encode(#ssh_msg_request_success{data = Data}) ->
- <<?BYTE(?SSH_MSG_REQUEST_SUCCESS), Data/binary>>;
+ <<?Ebyte(?SSH_MSG_REQUEST_SUCCESS), Data/binary>>;
+
encode(#ssh_msg_request_failure{}) ->
- <<?BYTE(?SSH_MSG_REQUEST_FAILURE)>>;
+ <<?Ebyte(?SSH_MSG_REQUEST_FAILURE)>>;
+
encode(#ssh_msg_channel_open{
channel_type = Type,
sender_channel = Sender,
@@ -49,9 +77,8 @@ encode(#ssh_msg_channel_open{
maximum_packet_size = Max,
data = Data
}) ->
- ssh_bits:encode([?SSH_MSG_CHANNEL_OPEN,
- Type, Sender, Window, Max, Data], [byte, string, uint32,
- uint32, uint32, '...']);
+ <<?Ebyte(?SSH_MSG_CHANNEL_OPEN), ?Estring(Type), ?Euint32(Sender), ?Euint32(Window), ?Euint32(Max), ?'E...'(Data)>>;
+
encode(#ssh_msg_channel_open_confirmation{
recipient_channel = Recipient,
sender_channel = Sender,
@@ -59,60 +86,63 @@ encode(#ssh_msg_channel_open_confirmation{
maximum_packet_size = MaxPacketSize,
data = Data
}) ->
- ssh_bits:encode([?SSH_MSG_CHANNEL_OPEN_CONFIRMATION, Recipient,
- Sender, InitWindowSize, MaxPacketSize, Data],
- [byte, uint32, uint32, uint32, uint32, '...']);
+ <<?Ebyte(?SSH_MSG_CHANNEL_OPEN_CONFIRMATION),
+ ?Euint32(Recipient), ?Euint32(Sender), ?Euint32(InitWindowSize), ?Euint32(MaxPacketSize),
+ ?'E...'(Data)>>;
+
encode(#ssh_msg_channel_open_failure{
recipient_channel = Recipient,
reason = Reason,
description = Desc,
lang = Lang
}) ->
- ssh_bits:encode([?SSH_MSG_CHANNEL_OPEN_FAILURE, Recipient,
- Reason, Desc, Lang], [byte, uint32, uint32, string, string]);
+ <<?Ebyte(?SSH_MSG_CHANNEL_OPEN_FAILURE), ?Euint32(Recipient),?Euint32(Reason), ?Estring(Desc), ?Estring(Lang)>>;
+
encode(#ssh_msg_channel_window_adjust{
recipient_channel = Recipient,
bytes_to_add = Bytes
}) ->
- ssh_bits:encode([?SSH_MSG_CHANNEL_WINDOW_ADJUST, Recipient, Bytes],
- [byte, uint32, uint32]);
+ <<?Ebyte(?SSH_MSG_CHANNEL_WINDOW_ADJUST), ?Euint32(Recipient), ?Euint32(Bytes)>>;
+
encode(#ssh_msg_channel_data{
recipient_channel = Recipient,
data = Data
}) ->
- ssh_bits:encode([?SSH_MSG_CHANNEL_DATA, Recipient, Data], [byte, uint32, binary]);
+ <<?Ebyte(?SSH_MSG_CHANNEL_DATA), ?Euint32(Recipient), ?Ebinary(Data)>>;
encode(#ssh_msg_channel_extended_data{
recipient_channel = Recipient,
data_type_code = DataType,
data = Data
}) ->
- ssh_bits:encode([?SSH_MSG_CHANNEL_EXTENDED_DATA, Recipient,
- DataType, Data], [byte, uint32, uint32, binary]);
+ <<?Ebyte(?SSH_MSG_CHANNEL_EXTENDED_DATA), ?Euint32(Recipient), ?Euint32(DataType), ?Ebinary(Data)>>;
encode(#ssh_msg_channel_eof{recipient_channel = Recipient
}) ->
- <<?BYTE(?SSH_MSG_CHANNEL_EOF), ?UINT32(Recipient)>>;
+ <<?Ebyte(?SSH_MSG_CHANNEL_EOF), ?Euint32(Recipient)>>;
+
encode(#ssh_msg_channel_close{
recipient_channel = Recipient
}) ->
- <<?BYTE(?SSH_MSG_CHANNEL_CLOSE), ?UINT32(Recipient)>>;
+ <<?Ebyte(?SSH_MSG_CHANNEL_CLOSE), ?Euint32(Recipient)>>;
+
encode(#ssh_msg_channel_request{
recipient_channel = Recipient,
request_type = Type,
want_reply = Bool,
data = Data
}) ->
- ssh_bits:encode([?SSH_MSG_CHANNEL_REQUEST, Recipient, Type, Bool, Data],
- [byte, uint32, string, boolean, '...']);
+ <<?Ebyte(?SSH_MSG_CHANNEL_REQUEST), ?Euint32(Recipient), ?Estring(Type), ?Eboolean(Bool), ?'E...'(Data)>>;
+
encode(#ssh_msg_channel_success{
recipient_channel = Recipient
}) ->
- <<?BYTE(?SSH_MSG_CHANNEL_SUCCESS), ?UINT32(Recipient)>>;
+ <<?Ebyte(?SSH_MSG_CHANNEL_SUCCESS), ?Euint32(Recipient)>>;
+
encode(#ssh_msg_channel_failure{
recipient_channel = Recipient
}) ->
- <<?BYTE(?SSH_MSG_CHANNEL_FAILURE), ?UINT32(Recipient)>>;
+ <<?Ebyte(?SSH_MSG_CHANNEL_FAILURE), ?Euint32(Recipient)>>;
encode(#ssh_msg_userauth_request{
user = User,
@@ -120,36 +150,33 @@ encode(#ssh_msg_userauth_request{
method = Method,
data = Data
}) ->
- ssh_bits:encode([?SSH_MSG_USERAUTH_REQUEST, User, Service, Method, Data],
- [byte, string_utf8, string, string, '...']);
+ <<?Ebyte(?SSH_MSG_USERAUTH_REQUEST), ?Estring_utf8(User), ?Estring(Service), ?Estring(Method), ?'E...'(Data)>>;
+
encode(#ssh_msg_userauth_failure{
authentications = Auths,
partial_success = Bool
}) ->
- ssh_bits:encode([?SSH_MSG_USERAUTH_FAILURE, Auths, Bool],
- [byte, string, boolean]);
+ <<?Ebyte(?SSH_MSG_USERAUTH_FAILURE), ?Estring(Auths), ?Eboolean(Bool)>>;
+
encode(#ssh_msg_userauth_success{}) ->
- <<?BYTE(?SSH_MSG_USERAUTH_SUCCESS)>>;
+ <<?Ebyte(?SSH_MSG_USERAUTH_SUCCESS)>>;
encode(#ssh_msg_userauth_banner{
message = Banner,
language = Lang
}) ->
- ssh_bits:encode([?SSH_MSG_USERAUTH_BANNER, Banner, Lang],
- [byte, string_utf8, string]);
+ <<?Ebyte(?SSH_MSG_USERAUTH_BANNER), ?Estring_utf8(Banner), ?Estring(Lang)>>;
encode(#ssh_msg_userauth_pk_ok{
algorithm_name = Alg,
key_blob = KeyBlob
}) ->
- ssh_bits:encode([?SSH_MSG_USERAUTH_PK_OK, Alg, KeyBlob],
- [byte, string, binary]);
+ <<?Ebyte(?SSH_MSG_USERAUTH_PK_OK), ?Estring(Alg), ?Ebinary(KeyBlob)>>;
encode(#ssh_msg_userauth_passwd_changereq{prompt = Prompt,
languge = Lang
})->
- ssh_bits:encode([?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ, Prompt, Lang],
- [byte, string, string]);
+ <<?Ebyte(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?Estring(Prompt), ?Estring(Lang)>>;
encode(#ssh_msg_userauth_info_request{
name = Name,
@@ -157,41 +184,37 @@ encode(#ssh_msg_userauth_info_request{
language_tag = Lang,
num_prompts = NumPromtps,
data = Data}) ->
- ssh_bits:encode([?SSH_MSG_USERAUTH_INFO_REQUEST, Name, Inst, Lang, NumPromtps, Data],
- [byte, string, string, string, uint32, '...']);
+ <<?Ebyte(?SSH_MSG_USERAUTH_INFO_REQUEST), ?Estring(Name), ?Estring(Inst), ?Estring(Lang),
+ ?Euint32(NumPromtps), ?'E...'(Data)>>;
encode(#ssh_msg_userauth_info_response{
num_responses = Num,
data = Data}) ->
- Responses = lists:map(fun("") ->
- <<>>;
- (Response) ->
- ssh_bits:encode([Response], [string])
- end, Data),
- Start = ssh_bits:encode([?SSH_MSG_USERAUTH_INFO_RESPONSE, Num],
- [byte, uint32]),
- iolist_to_binary([Start, Responses]);
+ lists:foldl(fun %%("", Acc) -> Acc; % commented out since it seem wrong
+ (Response, Acc) -> <<Acc/binary, ?Estring(Response)>>
+ end,
+ <<?Ebyte(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?Euint32(Num)>>,
+ Data);
encode(#ssh_msg_disconnect{
code = Code,
description = Desc,
language = Lang
}) ->
- ssh_bits:encode([?SSH_MSG_DISCONNECT, Code, Desc, Lang],
- [byte, uint32, string, string]);
+ <<?Ebyte(?SSH_MSG_DISCONNECT), ?Euint32(Code), ?Estring(Desc), ?Estring(Lang)>>;
encode(#ssh_msg_service_request{
name = Service
}) ->
- ssh_bits:encode([?SSH_MSG_SERVICE_REQUEST, Service], [byte, string]);
+ <<?Ebyte(?SSH_MSG_SERVICE_REQUEST), ?Estring(Service)>>;
encode(#ssh_msg_service_accept{
name = Service
}) ->
- ssh_bits:encode([?SSH_MSG_SERVICE_ACCEPT, Service], [byte, string]);
+ <<?Ebyte(?SSH_MSG_SERVICE_ACCEPT), ?Estring(Service)>>;
encode(#ssh_msg_newkeys{}) ->
- <<?BYTE(?SSH_MSG_NEWKEYS)>>;
+ <<?Ebyte(?SSH_MSG_NEWKEYS)>>;
encode(#ssh_msg_kexinit{
cookie = Cookie,
@@ -208,19 +231,13 @@ encode(#ssh_msg_kexinit{
first_kex_packet_follows = Bool,
reserved = Reserved
}) ->
- ssh_bits:encode([?SSH_MSG_KEXINIT, Cookie, KeyAlgs, HostKeyAlgs, EncAlgC2S, EncAlgS2C,
- MacAlgC2S, MacAlgS2C, CompAlgS2C, CompAlgC2S, LangC2S, LangS2C, Bool,
- Reserved],
- [byte, cookie,
- name_list, name_list,
- name_list, name_list,
- name_list, name_list,
- name_list, name_list,
- name_list, name_list,
- boolean, uint32]);
+ <<?Ebyte(?SSH_MSG_KEXINIT), Cookie/binary,
+ ?Ename_list(KeyAlgs), ?Ename_list(HostKeyAlgs), ?Ename_list(EncAlgC2S), ?Ename_list(EncAlgS2C), ?Ename_list(MacAlgC2S),
+ ?Ename_list(MacAlgS2C), ?Ename_list(CompAlgS2C), ?Ename_list(CompAlgC2S), ?Ename_list(LangC2S), ?Ename_list(LangS2C),
+ ?Eboolean(Bool), ?Euint32(Reserved)>>;
encode(#ssh_msg_kexdh_init{e = E}) ->
- ssh_bits:encode([?SSH_MSG_KEXDH_INIT, E], [byte, mpint]);
+ <<?Ebyte(?SSH_MSG_KEXDH_INIT), ?Empint(E)>>;
encode(#ssh_msg_kexdh_reply{
public_host_key = Key,
@@ -229,25 +246,23 @@ encode(#ssh_msg_kexdh_reply{
}) ->
EncKey = public_key:ssh_encode(Key, ssh2_pubkey),
EncSign = encode_signature(Key, Signature),
- ssh_bits:encode([?SSH_MSG_KEXDH_REPLY, EncKey, F, EncSign], [byte, binary, mpint, binary]);
+ <<?Ebyte(?SSH_MSG_KEXDH_REPLY), ?Ebinary(EncKey), ?Empint(F), ?Ebinary(EncSign)>>;
encode(#ssh_msg_kex_dh_gex_request{
min = Min,
n = N,
max = Max
}) ->
- ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REQUEST, Min, N, Max],
- [byte, uint32, uint32, uint32]);
+ <<?Ebyte(?SSH_MSG_KEX_DH_GEX_REQUEST), ?Euint32(Min), ?Euint32(N), ?Euint32(Max)>>;
+
encode(#ssh_msg_kex_dh_gex_request_old{n = N}) ->
- ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REQUEST_OLD, N],
- [byte, uint32]);
+ <<?Ebyte(?SSH_MSG_KEX_DH_GEX_REQUEST_OLD), ?Euint32(N)>>;
encode(#ssh_msg_kex_dh_gex_group{p = Prime, g = Generator}) ->
- ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_GROUP, Prime, Generator],
- [byte, mpint, mpint]);
+ <<?Ebyte(?SSH_MSG_KEX_DH_GEX_GROUP), ?Empint(Prime), ?Empint(Generator)>>;
encode(#ssh_msg_kex_dh_gex_init{e = Public}) ->
- ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_INIT, Public], [byte, mpint]);
+ <<?Ebyte(?SSH_MSG_KEX_DH_GEX_INIT), ?Empint(Public)>>;
encode(#ssh_msg_kex_dh_gex_reply{
%% Will be private key encode_host_key extracts only the public part!
@@ -257,26 +272,26 @@ encode(#ssh_msg_kex_dh_gex_reply{
}) ->
EncKey = public_key:ssh_encode(Key, ssh2_pubkey),
EncSign = encode_signature(Key, Signature),
- ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REPLY, EncKey, F, EncSign], [byte, binary, mpint, binary]);
+ <<?Ebyte(?SSH_MSG_KEX_DH_GEX_REPLY), ?Ebinary(EncKey), ?Empint(F), ?Ebinary(EncSign)>>;
encode(#ssh_msg_kex_ecdh_init{q_c = Q_c}) ->
- ssh_bits:encode([?SSH_MSG_KEX_ECDH_INIT, Q_c], [byte, mpint]);
+ <<?Ebyte(?SSH_MSG_KEX_ECDH_INIT), ?Empint(Q_c)>>;
encode(#ssh_msg_kex_ecdh_reply{public_host_key = Key, q_s = Q_s, h_sig = Sign}) ->
EncKey = public_key:ssh_encode(Key, ssh2_pubkey),
EncSign = encode_signature(Key, Sign),
- ssh_bits:encode([?SSH_MSG_KEX_ECDH_REPLY, EncKey, Q_s, EncSign], [byte, binary, mpint, binary]);
+ <<?Ebyte(?SSH_MSG_KEX_ECDH_REPLY), ?Ebinary(EncKey), ?Empint(Q_s), ?Ebinary(EncSign)>>;
encode(#ssh_msg_ignore{data = Data}) ->
- ssh_bits:encode([?SSH_MSG_IGNORE, Data], [byte, string]);
+ <<?Ebyte(?SSH_MSG_IGNORE), ?Estring(Data)>>;
encode(#ssh_msg_unimplemented{sequence = Seq}) ->
- ssh_bits:encode([?SSH_MSG_UNIMPLEMENTED, Seq], [byte, uint32]);
+ <<?Ebyte(?SSH_MSG_UNIMPLEMENTED), ?Euint32(Seq)>>;
encode(#ssh_msg_debug{always_display = Bool,
message = Msg,
language = Lang}) ->
- ssh_bits:encode([?SSH_MSG_DEBUG, Bool, Msg, Lang], [byte, boolean, string, string]).
+ <<?Ebyte(?SSH_MSG_DEBUG), ?Eboolean(Bool), ?Estring(Msg), ?Estring(Lang)>>.
%% Connection Messages
@@ -553,10 +568,10 @@ decode_signature(<<?DEC_BIN(_Alg,__0), ?UINT32(_), Signature/binary>>) ->
encode_signature(#'RSAPublicKey'{}, Signature) ->
- ssh_bits:encode(["ssh-rsa", Signature],[string, binary]);
+ <<?Ebinary(<<"ssh-rsa">>), ?Ebinary(Signature)>>;
encode_signature({_, #'Dss-Parms'{}}, Signature) ->
- ssh_bits:encode(["ssh-dss", Signature],[string, binary]);
+ <<?Ebinary(<<"ssh-dss">>), ?Ebinary(Signature)>>;
encode_signature({#'ECPoint'{}, {namedCurve,OID}}, Signature) ->
CurveName = public_key:oid2ssh_curvename(OID),
- ssh_bits:encode([<<"ecdsa-sha2-",CurveName/binary>>, Signature], [binary,binary]).
+ <<?Ebinary(<<"ecdsa-sha2-",CurveName/binary>>), ?Ebinary(Signature)>>.
diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl
index dbacf730cc..eb99406626 100644
--- a/lib/ssh/src/ssh_sftp.erl
+++ b/lib/ssh/src/ssh_sftp.erl
@@ -99,8 +99,8 @@ start_channel(Host) when is_list(Host) ->
start_channel(Host, []).
start_channel(Cm, Opts) when is_pid(Cm) ->
Timeout = proplists:get_value(timeout, Opts, infinity),
- {_, SftpOpts} = handle_options(Opts, [], []),
- case ssh_xfer:attach(Cm, []) of
+ {_, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []),
+ case ssh_xfer:attach(Cm, [], ChanOpts) of
{ok, ChannelId, Cm} ->
case ssh_channel:start(Cm, ChannelId,
?MODULE, [Cm, ChannelId, SftpOpts]) of
@@ -123,9 +123,9 @@ start_channel(Cm, Opts) when is_pid(Cm) ->
start_channel(Host, Opts) ->
start_channel(Host, 22, Opts).
start_channel(Host, Port, Opts) ->
- {SshOpts, SftpOpts} = handle_options(Opts, [], []),
+ {SshOpts, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []),
Timeout = proplists:get_value(timeout, SftpOpts, infinity),
- case ssh_xfer:connect(Host, Port, SshOpts, Timeout) of
+ case ssh_xfer:connect(Host, Port, SshOpts, ChanOpts, Timeout) of
{ok, ChannelId, Cm} ->
case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm,
ChannelId, SftpOpts]) of
@@ -842,14 +842,18 @@ terminate(_Reason, State) ->
%%====================================================================
%% Internal functions
%%====================================================================
-handle_options([], Sftp, Ssh) ->
- {Ssh, Sftp};
-handle_options([{timeout, _} = Opt | Rest], Sftp, Ssh) ->
- handle_options(Rest, [Opt | Sftp], Ssh);
-handle_options([{sftp_vsn, _} = Opt| Rest], Sftp, Ssh) ->
- handle_options(Rest, [Opt | Sftp], Ssh);
-handle_options([Opt | Rest], Sftp, Ssh) ->
- handle_options(Rest, Sftp, [Opt | Ssh]).
+handle_options([], Sftp, Chan, Ssh) ->
+ {Ssh, Chan, Sftp};
+handle_options([{timeout, _} = Opt | Rest], Sftp, Chan, Ssh) ->
+ handle_options(Rest, [Opt|Sftp], Chan, Ssh);
+handle_options([{sftp_vsn, _} = Opt| Rest], Sftp, Chan, Ssh) ->
+ handle_options(Rest, [Opt|Sftp], Chan, Ssh);
+handle_options([{window_size, _} = Opt| Rest], Sftp, Chan, Ssh) ->
+ handle_options(Rest, Sftp, [Opt|Chan], Ssh);
+handle_options([{packet_size, _} = Opt| Rest], Sftp, Chan, Ssh) ->
+ handle_options(Rest, Sftp, [Opt|Chan], Ssh);
+handle_options([Opt|Rest], Sftp, Chan, Ssh) ->
+ handle_options(Rest, Sftp, Chan, [Opt|Ssh]).
call(Pid, Msg, TimeOut) ->
ssh_channel:call(Pid, {{timeout, TimeOut}, Msg}, infinity).
diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index 18037b8461..a648c7af3d 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -52,6 +52,14 @@
-export([pack/3]).
-export([decompress/2, decrypt_blocks/3, is_valid_mac/3 ]). % FIXME: remove
+-define(Estring(X), ?STRING((if is_binary(X) -> X;
+ is_list(X) -> list_to_binary(X);
+ X==undefined -> <<>>
+ end))).
+-define(Empint(X), (ssh_bits:mpint(X))/binary ).
+-define(Ebinary(X), ?STRING(X) ).
+-define(Euint32(X), ?UINT32(X) ).
+
%%%----------------------------------------------------------------------------
%%%
%%% There is a difference between supported and default algorithms. The
@@ -1084,7 +1092,7 @@ sign(SigData, Hash, #'DSAPrivateKey'{} = Key) ->
sign(SigData, Hash, Key = #'ECPrivateKey'{}) ->
DerEncodedSign = public_key:sign(SigData, Hash, Key),
#'ECDSA-Sig-Value'{r=R, s=S} = public_key:der_decode('ECDSA-Sig-Value', DerEncodedSign),
- ssh_bits:encode([R,S], [mpint,mpint]);
+ <<?Empint(R),?Empint(S)>>;
sign(SigData, Hash, Key) ->
public_key:sign(SigData, Hash, Key).
@@ -1584,21 +1592,16 @@ hash(K, H, Ki, N, HASH) ->
kex_h(SSH, Key, E, F, K) ->
KeyBin = public_key:ssh_encode(Key, ssh2_pubkey),
- L = ssh_bits:encode([SSH#ssh.c_version, SSH#ssh.s_version,
- SSH#ssh.c_keyinit, SSH#ssh.s_keyinit,
- KeyBin, E,F,K],
- [string,string,binary,binary,binary,
- mpint,mpint,mpint]),
+ L = <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version),
+ ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(KeyBin),
+ ?Empint(E), ?Empint(F), ?Empint(K)>>,
crypto:hash(sha((SSH#ssh.algorithms)#alg.kex), L).
-%% crypto:hash(sha,L).
kex_h(SSH, Curve, Key, Q_c, Q_s, K) ->
KeyBin = public_key:ssh_encode(Key, ssh2_pubkey),
- L = ssh_bits:encode([SSH#ssh.c_version, SSH#ssh.s_version,
- SSH#ssh.c_keyinit, SSH#ssh.s_keyinit,
- KeyBin, Q_c, Q_s, K],
- [string,string,binary,binary,binary,
- mpint,mpint,mpint]),
+ L = <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version),
+ ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(KeyBin),
+ ?Empint(Q_c), ?Empint(Q_s), ?Empint(K)>>,
crypto:hash(sha(Curve), L).
kex_h(SSH, Key, Min, NBits, Max, Prime, Gen, E, F, K) ->
@@ -1607,21 +1610,14 @@ kex_h(SSH, Key, Min, NBits, Max, Prime, Gen, E, F, K) ->
%% flag from 'ssh_msg_kex_dh_gex_request_old'
%% It was like this before that message was supported,
%% why?
- Ts = [string,string,binary,binary,binary,
- uint32,
- mpint,mpint,mpint,mpint,mpint],
- ssh_bits:encode([SSH#ssh.c_version,SSH#ssh.s_version,
- SSH#ssh.c_keyinit,SSH#ssh.s_keyinit,
- KeyBin, NBits, Prime, Gen, E,F,K],
- Ts);
+ <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version),
+ ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(KeyBin),
+ ?Empint(E), ?Empint(F), ?Empint(K)>>;
true ->
- Ts = [string,string,binary,binary,binary,
- uint32,uint32,uint32,
- mpint,mpint,mpint,mpint,mpint],
- ssh_bits:encode([SSH#ssh.c_version,SSH#ssh.s_version,
- SSH#ssh.c_keyinit,SSH#ssh.s_keyinit,
- KeyBin, Min, NBits, Max,
- Prime, Gen, E,F,K], Ts)
+ <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version),
+ ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(KeyBin),
+ ?Euint32(Min), ?Euint32(NBits), ?Euint32(Max),
+ ?Empint(Prime), ?Empint(Gen), ?Empint(E), ?Empint(F), ?Empint(K)>>
end,
crypto:hash(sha((SSH#ssh.algorithms)#alg.kex), L).
diff --git a/lib/ssh/src/ssh_xfer.erl b/lib/ssh/src/ssh_xfer.erl
index b8dff1c533..259dc71aa5 100644
--- a/lib/ssh/src/ssh_xfer.erl
+++ b/lib/ssh/src/ssh_xfer.erl
@@ -24,7 +24,7 @@
-module(ssh_xfer).
--export([attach/2, connect/3, connect/4]).
+-export([attach/2, attach/3, connect/3, connect/4, connect/5]).
-export([open/6, opendir/3, readdir/3, close/3, read/5, write/5,
rename/5, remove/3, mkdir/4, rmdir/3, realpath/3, extended/4,
stat/4, fstat/4, lstat/4, setstat/4,
@@ -47,28 +47,38 @@
-define(is_set(F, Bits),
((F) band (Bits)) == (F)).
--define(XFER_PACKET_SIZE, 32768).
--define(XFER_WINDOW_SIZE, 4*?XFER_PACKET_SIZE).
+-define(XFER_PACKET_SIZE, 65536).
+-define(XFER_WINDOW_SIZE, 20*?XFER_PACKET_SIZE).
attach(CM, Opts) ->
- open_xfer(CM, Opts).
+ open_xfer(CM, Opts, []).
+
+attach(CM, Opts, ChanOpts) ->
+ open_xfer(CM, Opts, ChanOpts).
+
connect(Host, Port, Opts) ->
case ssh:connect(Host, Port, Opts) of
- {ok, CM} -> open_xfer(CM, Opts);
+ {ok, CM} -> open_xfer(CM, Opts, []);
Error -> Error
end.
connect(Host, Port, Opts, Timeout) ->
+ connect(Host, Port, Opts, [], Timeout).
+
+connect(Host, Port, Opts, ChanOpts, Timeout) ->
case ssh:connect(Host, Port, Opts, Timeout) of
- {ok, CM} -> open_xfer(CM, [{timeout, Timeout}|Opts]);
+ {ok, CM} -> open_xfer(CM, [{timeout, Timeout}|Opts], ChanOpts);
{error, Timeout} -> {error, timeout};
Error -> Error
end.
-open_xfer(CM, Opts) ->
+
+open_xfer(CM, Opts, ChanOpts) ->
TMO = proplists:get_value(timeout, Opts, infinity),
- case ssh_connection:session_channel(CM, ?XFER_WINDOW_SIZE, ?XFER_PACKET_SIZE, TMO) of
+ WindowSize = proplists:get_value(window_size, ChanOpts, ?XFER_WINDOW_SIZE),
+ PacketSize = proplists:get_value(packet_size, ChanOpts, ?XFER_PACKET_SIZE),
+ case ssh_connection:session_channel(CM, WindowSize, PacketSize, TMO) of
{ok, ChannelId} ->
{ok, ChannelId, CM};
Error ->
diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile
index 9cd98f069f..fb539f98fa 100644
--- a/lib/ssh/test/Makefile
+++ b/lib/ssh/test/Makefile
@@ -64,8 +64,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
DATA_DIRS = $(MODULES:%=%_data)
-INCLUDES = -I$(ERL_TOP)/lib/test_server/include \
- -I$(ERL_TOP)/lib/ssh/src \
+INCLUDES = -I$(ERL_TOP)/lib/ssh/src
EMAKEFILE=Emakefile
MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile)
@@ -88,8 +87,7 @@ RELSYSDIR = $(RELEASE_PATH)/ssh_test
# The path to the test_server ebin dir is needed when
# running the target "targets".
# ----------------------------------------------------
-ERL_COMPILE_FLAGS += -pa ../../../internal_tools/test_server/ebin \
- $(INCLUDES)
+ERL_COMPILE_FLAGS += $(INCLUDES)
EBIN = .
diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl
index b6603d29e5..cabdd35615 100644
--- a/lib/ssh/test/ssh_protocol_SUITE.erl
+++ b/lib/ssh/test/ssh_protocol_SUITE.erl
@@ -308,7 +308,7 @@ no_common_alg_client_disconnects(Config) ->
{send, hello},
{match, #ssh_msg_kexinit{_='_'}, receive_msg},
{send, #ssh_msg_kexinit{ % with unsupported "SOME-UNSUPPORTED"
- cookie = 247381486335508958743193106082599558706,
+ cookie = <<80,158,95,51,174,35,73,130,246,141,200,49,180,190,82,234>>,
kex_algorithms = ["diffie-hellman-group1-sha1"],
server_host_key_algorithms = ["SOME-UNSUPPORTED"], % SIC!
encryption_algorithms_client_to_server = ["aes128-ctr"],
diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml
index 6c82e32a74..d05ece3971 100644
--- a/lib/ssl/doc/src/ssl_app.xml
+++ b/lib/ssl/doc/src/ssl_app.xml
@@ -43,6 +43,8 @@
<item>For security reasons SSL-2.0 is not supported.</item>
<item>For security reasons SSL-3.0 is no longer supported by default,
but can be configured.</item>
+ <item>For security reasons DES cipher suites are no longer supported by default,
+ but can be configured.</item>
<item>Ephemeral Diffie-Hellman cipher suites are supported,
but not Diffie Hellman Certificates cipher suites.</item>
<item>Elliptic Curve cipher suites are supported if the Crypto
@@ -55,8 +57,8 @@
motivated to implement them.</item>
<item>CRL validation is supported.</item>
<item>Policy certificate extensions are not supported.</item>
- <item>'Server Name Indication' extension client side
- (RFC 6066, Section 3) is supported.</item>
+ <item>'Server Name Indication' extension
+ (<url href="http://www.ietf.org/rfc/rfc6066.txt">RFC 6066</url>) is supported.</item>
</list>
</description>
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 974a6ec6b5..d737f74aa3 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -38,7 +38,7 @@
cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6,
suite/1, suites/1, all_suites/1,
ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0,
- rc4_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1,
+ rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1,
hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1]).
-export_type([cipher_suite/0,
@@ -315,7 +315,8 @@ all_suites(Version) ->
++ anonymous_suites(Version)
++ psk_suites(Version)
++ srp_suites()
- ++ rc4_suites(Version).
+ ++ rc4_suites(Version)
+ ++ des_suites(Version).
%%--------------------------------------------------------------------
-spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()].
%%
@@ -419,6 +420,16 @@ rc4_suites({3, N}) when N =< 3 ->
?TLS_RSA_WITH_RC4_128_MD5,
?TLS_ECDH_ECDSA_WITH_RC4_128_SHA,
?TLS_ECDH_RSA_WITH_RC4_128_SHA].
+%%--------------------------------------------------------------------
+-spec des_suites(Version::ssl_record:ssl_version()) -> [cipher_suite()].
+%%
+%% Description: Returns a list of the cipher suites
+%% with DES cipher, only supported if explicitly set by user.
+%% Are not considered secure any more.
+%%--------------------------------------------------------------------
+des_suites(_)->
+ [?TLS_DHE_RSA_WITH_DES_CBC_SHA,
+ ?TLS_RSA_WITH_DES_CBC_SHA].
%%--------------------------------------------------------------------
-spec suite_definition(cipher_suite()) -> erl_cipher_suite().
@@ -1728,7 +1739,8 @@ dhe_rsa_suites() ->
?TLS_DHE_RSA_WITH_DES_CBC_SHA,
?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256,
?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384,
- ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256].
+ ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256
+ ].
psk_rsa_suites() ->
[?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384,
diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl
index 9a58f2b8f7..bb41ef2b62 100644
--- a/lib/ssl/src/ssl_connection.hrl
+++ b/lib/ssl/src/ssl_connection.hrl
@@ -48,27 +48,28 @@
socket_options :: #socket_options{},
connection_states :: #connection_states{} | secret_printout(),
protocol_buffers :: term() | secret_printout() , %% #protocol_buffers{} from tls_record.hrl or dtls_recor.hrl
- tls_handshake_history :: ssl_handshake:ssl_handshake_history() | secret_printout(),
- cert_db :: reference(),
+ tls_handshake_history :: ssl_handshake:ssl_handshake_history() | secret_printout()
+ | 'undefined',
+ cert_db :: reference() | 'undefined',
session :: #session{} | secret_printout(),
session_cache :: db_handle(),
session_cache_cb :: atom(),
crl_db :: term(),
- negotiated_version :: ssl_record:ssl_version(),
+ negotiated_version :: ssl_record:ssl_version() | 'undefined',
client_certificate_requested = false :: boolean(),
key_algorithm :: ssl_cipher:key_algo(),
hashsign_algorithm = {undefined, undefined},
cert_hashsign_algorithm,
- public_key_info :: ssl_handshake:public_key_info(),
- private_key :: public_key:private_key() | secret_printout(),
+ public_key_info :: ssl_handshake:public_key_info() | 'undefined',
+ private_key :: public_key:private_key() | secret_printout() | 'undefined',
diffie_hellman_params:: #'DHParameter'{} | undefined | secret_printout(),
diffie_hellman_keys :: {PublicKey :: binary(), PrivateKey :: binary()} | #'ECPrivateKey'{} | undefined | secret_printout(),
- psk_identity :: binary(), % server psk identity hint
- srp_params :: #srp_user{} | secret_printout(),
- srp_keys ::{PublicKey :: binary(), PrivateKey :: binary()} | secret_printout(),
- premaster_secret :: binary() | secret_printout() ,
+ psk_identity :: binary() | 'undefined', % server psk identity hint
+ srp_params :: #srp_user{} | secret_printout() | 'undefined',
+ srp_keys ::{PublicKey :: binary(), PrivateKey :: binary()} | secret_printout() | 'undefined',
+ premaster_secret :: binary() | secret_printout() | 'undefined',
file_ref_db :: db_handle(),
- cert_db_ref :: certdb_ref(),
+ cert_db_ref :: certdb_ref() | 'undefined',
bytes_to_read :: undefined | integer(), %% bytes to read in passive mode
user_data_buffer :: undefined | binary() | secret_printout(),
renegotiation :: undefined | {boolean(), From::term() | internal | peer},
@@ -81,7 +82,7 @@
expecting_finished = false ::boolean(),
negotiated_protocol = undefined :: undefined | binary(),
client_ecc, % {Curves, PointFmt}
- tracker :: pid(), %% Tracker process for listen socket
+ tracker :: pid() | 'undefined', %% Tracker process for listen socket
sni_hostname = undefined
}).
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 8c7ed9c0d1..913746598f 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -93,16 +93,16 @@
validate_extensions_fun,
depth :: integer(),
certfile :: binary(),
- cert :: public_key:der_encoded() | secret_printout(),
+ cert :: public_key:der_encoded() | secret_printout() | 'undefined',
keyfile :: binary(),
- key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', public_key:der_encoded()} | secret_printout(),
- password :: string() | secret_printout(),
- cacerts :: [public_key:der_encoded()] | secret_printout(),
+ key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', public_key:der_encoded()} | secret_printout() | 'undefined',
+ password :: string() | secret_printout() | 'undefined',
+ cacerts :: [public_key:der_encoded()] | secret_printout() | 'undefined',
cacertfile :: binary(),
dh :: public_key:der_encoded() | secret_printout(),
- dhfile :: binary() | secret_printout(),
+ dhfile :: binary() | secret_printout() | 'undefined',
user_lookup_fun, % server option, fun to lookup the user
- psk_identity :: binary() | secret_printout() ,
+ psk_identity :: binary() | secret_printout() | 'undefined',
srp_identity, % client option {User, Password}
ciphers, %
%% Local policy for the server if it want's to reuse the session
@@ -118,7 +118,7 @@
%% undefined if not hibernating, or number of ms of
%% inactivity after which ssl_connection will go into
%% hibernation
- hibernate_after :: boolean(),
+ hibernate_after :: boolean() | 'undefined',
%% This option should only be set to true by inet_tls_dist
erl_dist = false :: boolean(),
alpn_advertised_protocols = undefined :: [binary()] | undefined ,
diff --git a/lib/ssl/src/ssl_v3.erl b/lib/ssl/src/ssl_v3.erl
index f169059a75..f98ea83771 100644
--- a/lib/ssl/src/ssl_v3.erl
+++ b/lib/ssl/src/ssl_v3.erl
@@ -143,9 +143,7 @@ suites() ->
?TLS_RSA_WITH_3DES_EDE_CBC_SHA,
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_DHE_DSS_WITH_AES_128_CBC_SHA,
- ?TLS_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_DHE_RSA_WITH_DES_CBC_SHA,
- ?TLS_RSA_WITH_DES_CBC_SHA
+ ?TLS_RSA_WITH_AES_128_CBC_SHA
].
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl
index 71e5f349dd..09e378cfeb 100644
--- a/lib/ssl/src/tls_v1.erl
+++ b/lib/ssl/src/tls_v1.erl
@@ -208,9 +208,7 @@ suites(Minor) when Minor == 1; Minor == 2 ->
?TLS_DHE_DSS_WITH_AES_128_CBC_SHA,
?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_DHE_RSA_WITH_DES_CBC_SHA,
- ?TLS_RSA_WITH_DES_CBC_SHA
+ ?TLS_RSA_WITH_AES_128_CBC_SHA
];
suites(3) ->
[
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 999df320a3..89a62c3a4b 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -81,7 +81,7 @@ HRL_FILES_NEEDED_IN_TEST = \
TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-INCLUDES = -I. -I$(ERL_TOP)/lib/test_server/include/
+INCLUDES = -I.
DATADIRS = ssl_basic_SUITE_data
@@ -100,8 +100,7 @@ RELSYSDIR = $(RELEASE_PATH)/ssl_test
# The path to the test_server ebin dir is needed when
# running the target "targets".
# ----------------------------------------------------
-ERL_COMPILE_FLAGS += -pa ../../../internal_tools/test_server/ebin \
- $(INCLUDES)
+ERL_COMPILE_FLAGS += $(INCLUDES)
# ----------------------------------------------------
# Targets
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 1a864edb8b..847a9f19de 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -183,6 +183,8 @@ cipher_tests() ->
rc4_rsa_cipher_suites,
rc4_ecdh_rsa_cipher_suites,
rc4_ecdsa_cipher_suites,
+ des_rsa_cipher_suites,
+ des_ecdh_rsa_cipher_suites,
default_reject_anonymous].
cipher_tests_ec() ->
@@ -445,7 +447,7 @@ connection_info(Config) when is_list(Config) ->
{from, self()},
{mfa, {?MODULE, connection_info_result, []}},
{options,
- [{ciphers,[{rsa,des_cbc,sha,no_export}]} |
+ [{ciphers,[{rsa, aes_128_cbc, sha}]} |
ClientOpts]}]),
ct:log("Testcase ~p, Client ~p Server ~p ~n",
@@ -454,7 +456,7 @@ connection_info(Config) when is_list(Config) ->
Version =
tls_record:protocol_version(tls_record:highest_protocol_version([])),
- ServerMsg = ClientMsg = {ok, {Version, {rsa, des_cbc, sha}}},
+ ServerMsg = ClientMsg = {ok, {Version, {rsa, aes_128_cbc, sha}}},
ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg),
@@ -1982,6 +1984,23 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) ->
Ciphers = ssl_test_lib:rc4_suites(NVersion),
run_suites(Ciphers, Version, Config, rc4_ecdsa).
+%%-------------------------------------------------------------------
+des_rsa_cipher_suites()->
+ [{doc, "Test the RC4 ciphersuites"}].
+des_rsa_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
+ Version = tls_record:protocol_version(NVersion),
+ Ciphers = ssl_test_lib:des_suites(NVersion),
+ run_suites(Ciphers, Version, Config, des_rsa).
+%-------------------------------------------------------------------
+des_ecdh_rsa_cipher_suites()->
+ [{doc, "Test the RC4 ciphersuites"}].
+des_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
+ Version = tls_record:protocol_version(NVersion),
+ Ciphers = ssl_test_lib:des_suites(NVersion),
+ run_suites(Ciphers, Version, Config, des_dhe_rsa).
+
%%--------------------------------------------------------------------
default_reject_anonymous()->
[{doc,"Test that by default anonymous cipher suites are rejected "}].
@@ -2718,7 +2737,12 @@ defaults(Config) when is_list(Config)->
true = lists:member(sslv3, Available),
false = lists:member(sslv3, Supported),
false = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites()),
- true = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites(all)).
+ true = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites(all)),
+ false = lists:member({rsa,des_cbc,sha}, ssl:cipher_suites()),
+ true = lists:member({rsa,des_cbc,sha}, ssl:cipher_suites(all)),
+ false = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites()),
+ true = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites(all)).
+
%%--------------------------------------------------------------------
reuseaddr() ->
[{doc,"Test reuseaddr option"}].
@@ -4006,7 +4030,15 @@ run_suites(Ciphers, Version, Config, Type) ->
rc4_ecdsa ->
{?config(client_opts, Config),
[{ciphers, Ciphers} |
- ?config(server_ecdsa_opts, Config)]}
+ ?config(server_ecdsa_opts, Config)]};
+ des_dhe_rsa ->
+ {?config(client_opts, Config),
+ [{ciphers, Ciphers} |
+ ?config(server_rsa_opts, Config)]};
+ des_rsa ->
+ {?config(client_opts, Config),
+ [{ciphers, Ciphers} |
+ ?config(server_opts, Config)]}
end,
Result = lists:map(fun(Cipher) ->
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 90fcd193cc..b0495cb5ac 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -981,6 +981,10 @@ rc4_suites(Version) ->
Suites = ssl_cipher:rc4_suites(Version),
ssl_cipher:filter_suites(Suites).
+des_suites(Version) ->
+ Suites = ssl_cipher:des_suites(Version),
+ ssl_cipher:filter_suites(Suites).
+
pem_to_der(File) ->
{ok, PemBin} = file:read_file(File),
public_key:pem_decode(PemBin).
diff --git a/lib/ssl/test/ssl_upgrade_SUITE.erl b/lib/ssl/test/ssl_upgrade_SUITE.erl
index d65bdf6983..f5f4b25b23 100644
--- a/lib/ssl/test/ssl_upgrade_SUITE.erl
+++ b/lib/ssl/test/ssl_upgrade_SUITE.erl
@@ -40,20 +40,19 @@ all() ->
init_per_suite(Config0) ->
catch crypto:stop(),
- try {crypto:start(), erlang:system_info({wordsize, internal}) == erlang:system_info({wordsize, external})} of
- {ok, true} ->
- case ct_release_test:init(Config0) of
- {skip, Reason} ->
- {skip, Reason};
- Config ->
- {ok, _} = make_certs:all(?config(data_dir, Config),
- ?config(priv_dir, Config)),
- ssl_test_lib:cert_options(Config)
- end;
- {ok, false} ->
- {skip, "Test server will not handle halfwordemulator correctly. Skip as halfwordemulator is deprecated"}
+ try crypto:start() of
+ ok ->
+ case ct_release_test:init(Config0) of
+ {skip, Reason} ->
+ {skip, Reason};
+ Config ->
+ Result =
+ {ok, _} = make_certs:all(?config(data_dir, Config),
+ ?config(priv_dir, Config)),
+ ssl_test_lib:cert_options(Config)
+ end
catch _:_ ->
- {skip, "Crypto did not start"}
+ {skip, "Crypto did not start"}
end.
end_per_suite(Config) ->
diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml
index 0938b5dec3..13be488c33 100644
--- a/lib/stdlib/doc/src/erl_parse.xml
+++ b/lib/stdlib/doc/src/erl_parse.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2015</year>
+ <year>1996</year><year>2016</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -44,21 +44,33 @@
</description>
<datatypes>
<datatype>
- <name name="abstract_clause"></name>
- <desc><p>Parse tree for Erlang clause.</p>
+ <name>abstract_clause()</name>
+ <desc><p><marker id="type-abstract_clause"/>
+ Abstract form of an Erlang clause.</p>
</desc>
</datatype>
<datatype>
- <name name="abstract_expr"></name>
- <desc><p>Parse tree for Erlang expression.</p>
+ <name>abstract_expr()</name>
+ <desc><p><marker id="type-abstract_expr"/>
+ Abstract form of an Erlang expression.</p>
</desc>
</datatype>
<datatype>
- <name name="abstract_form"></name>
- <desc><p>Parse tree for Erlang form.</p>
+ <name>abstract_form()</name>
+ <desc><p><marker id="type-abstract_form"/>
+ Abstract form of an Erlang form.</p>
</desc>
</datatype>
<datatype>
+ <name>abstract_type()</name>
+ <desc><p><marker id="type-abstract_type"/>
+ Abstract form of an Erlang type.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="erl_parse_tree"></name>
+ </datatype>
+ <datatype>
<name name="error_description"></name>
</datatype>
<datatype>
@@ -180,7 +192,7 @@
<p>Converts the Erlang data structure <c><anno>Data</anno></c> into an
abstract form of type <c><anno>AbsTerm</anno></c>.</p>
<p>The <c><anno>Line</anno></c> option is the line that will
- be assigned to each node of the abstract form.</p>
+ be assigned to each node of <c><anno>AbsTerm</anno></c>.</p>
<p>The <c><anno>Encoding</anno></c> option is used for
selecting which integer lists will be considered
as strings. The default is to use the encoding returned by
@@ -196,47 +208,53 @@
<func>
<name name="map_anno" arity="2"/>
<fsummary>
- Map a function over the annotations of an abstract form
+ Map a function over the annotations of a <c>erl_parse</c> tree
</fsummary>
<desc>
- <p>Modifies the abstract form <anno>Abstr</anno> by applying
- <anno>Fun</anno> on every collection of annotations of the
- abstract form. The abstract form is traversed in a
- depth-first, left-to-right, fashion.
+ <p>Modifies the <c>erl_parse</c> tree <c><anno>Abstr</anno></c>
+ by applying <c><anno>Fun</anno></c> on each collection of
+ annotations of the nodes of the <c>erl_parse</c> tree. The
+ <c>erl_parse</c> tree is traversed in a depth-first,
+ left-to-right, fashion.
</p>
</desc>
</func>
<func>
<name name="fold_anno" arity="3"/>
<fsummary>
- Fold a function over the annotations of an abstract form
+ Fold a function over the annotations of a <c>erl_parse</c> tree
</fsummary>
<desc>
- <p>Updates an accumulator by applying <anno>Fun</anno> on
- every collection of annotations of the abstract form
- <anno>Abstr</anno>. The first call to <anno>Fun</anno> has
- <anno>AccIn</anno> as argument, and the returned accumulator
- <anno>AccOut</anno> is passed to the next call, and so on.
- The final value of the accumulator is returned. The abstract
- form is traversed in a depth-first, left-to-right, fashion.
+ <p>Updates an accumulator by applying <c><anno>Fun</anno></c> on
+ each collection of annotations of the <c>erl_parse</c> tree
+ <c><anno>Abstr</anno></c>. The first call to
+ <c><anno>Fun</anno></c> has <c><anno>AccIn</anno></c> as
+ argument, and the returned accumulator
+ <c><anno>AccOut</anno></c> is passed to the next call, and
+ so on. The final value of the accumulator is returned. The
+ <c>erl_parse</c> tree is traversed in a depth-first, left-to-right,
+ fashion.
</p>
</desc>
</func>
<func>
<name name="mapfold_anno" arity="3"/>
<fsummary>
- Map and fold a function over the annotations of an abstract form
+ Map and fold a function over the annotations of a
+ <c>erl_parse</c> tree
</fsummary>
<desc>
- <p>Modifies the abstract form <anno>Abstr</anno> by applying
- <anno>Fun</anno> on every collection of annotations of the
- abstract form, while at the same time updating an
- accumulator. The first call to <anno>Fun</anno> has
- <anno>AccIn</anno> as second argument, and the returned
- accumulator <anno>AccOut</anno> is passed to the next call,
- and so on. The modified abstract form as well as the the
- final value of the accumulator is returned. The abstract
- form is traversed in a depth-first, left-to-right, fashion.
+ <p>Modifies the <c>erl_parse</c> tree <c><anno>Abstr</anno></c>
+ by applying <c><anno>Fun</anno></c> on each collection of
+ annotations of the nodes of the <c>erl_parse</c> tree, while
+ at the same time updating an accumulator. The first call to
+ <c><anno>Fun</anno></c> has <c><anno>AccIn</anno></c> as
+ second argument, and the returned accumulator
+ <c><anno>AccOut</anno></c> is passed to the next call, and
+ so on. The modified <c>erl_parse</c> tree as well as the the
+ final value of the accumulator are returned. The
+ <c>erl_parse</c> tree is traversed in a depth-first,
+ left-to-right, fashion.
</p>
</desc>
</func>
@@ -246,12 +264,15 @@
Create new annotations
</fsummary>
<desc>
- <p>Creates an abstract form from a term which has the same
- structure as an abstract form, but <seealso
- marker="erl_anno#type-location">locations</seealso> where the
- abstract form has annotations. For each location, <seealso
- marker="erl_anno#new/1"><c>erl_anno:new/1</c></seealso> is
- called, and the annotations replace the location.
+ <p>Assumes that <c><anno>Term</anno></c> is a term with the same
+ structure as a <c>erl_parse</c> tree, but with <seealso
+ marker="erl_anno#type-location">locations</seealso> where a
+ <c>erl_parse</c> tree has collections of annotations.
+ Returns a <c>erl_parse</c> tree where each location <c>L</c>
+ has been replaced by the value returned by <seealso
+ marker="erl_anno#new/1"><c>erl_anno:new(L)</c></seealso>.
+ The term <c><anno>Term</anno></c> is traversed in a
+ depth-first, left-to-right, fashion.
</p>
</desc>
</func>
@@ -261,12 +282,14 @@
Return annotations as terms
</fsummary>
<desc>
- <p>Assumes that <anno>Term</anno> is a term with the same
- structure as an abstract form, but with terms, T say, on
- those places where an abstract form has annotations. Returns
- an abstract form where every term T has been replaced by the
- value returned by calling <c>erl_anno:from_term(T)</c>. The
- term <anno>Term</anno> is traversed in a depth-first,
+ <p>Assumes that <c><anno>Term</anno></c> is a term with the same
+ structure as a <c>erl_parse</c> tree, but with terms,
+ <c>T</c> say, where a <c>erl_parse</c> tree has collections
+ of annotations. Returns a <c>erl_parse</c> tree where each
+ term <c>T</c> has been replaced by the value returned by
+ <seealso marker="erl_anno#from_term/1">
+ <c>erl_anno:from_term(T)</c></seealso>. The term
+ <c><anno>Term</anno></c> is traversed in a depth-first,
left-to-right, fashion.
</p>
</desc>
@@ -277,10 +300,13 @@
Return the representation of annotations
</fsummary>
<desc>
- <p>Returns a term where every collection of annotations Anno of
- <anno>Abstr</anno> has been replaced by the term returned by
- calling <c>erl_anno:to_term(Anno)</c>. The abstract form is
- traversed in a depth-first, left-to-right, fashion.
+ <p>Returns a term where each collection of annotations
+ <c>Anno</c> of the nodes of the <c>erl_parse</c> tree
+ <c><anno>Abstr</anno></c> has been replaced by the term
+ returned by <seealso marker="erl_anno#to_term/1">
+ <c>erl_anno:to_term(Anno)</c></seealso>. The
+ <c>erl_parse</c> tree is traversed in a depth-first,
+ left-to-right, fashion.
</p>
</desc>
</func>
diff --git a/lib/stdlib/doc/src/erl_scan.xml b/lib/stdlib/doc/src/erl_scan.xml
index 342f491dd0..ee0d6b6033 100644
--- a/lib/stdlib/doc/src/erl_scan.xml
+++ b/lib/stdlib/doc/src/erl_scan.xml
@@ -40,39 +40,15 @@
</description>
<datatypes>
<datatype>
- <name name="attribute_info"></name>
- </datatype>
- <datatype>
- <name name="attributes"></name>
- </datatype>
- <datatype>
- <name name="attributes_data"></name>
- </datatype>
- <datatype>
<name name="category"></name>
</datatype>
<datatype>
- <name name="column"></name>
- </datatype>
- <datatype>
<name name="error_description"></name>
</datatype>
<datatype>
<name name="error_info"></name>
</datatype>
<datatype>
- <name name="info_line"></name>
- </datatype>
- <datatype>
- <name name="info_location"></name>
- </datatype>
- <datatype>
- <name name="line"></name>
- </datatype>
- <datatype>
- <name name="location"></name>
- </datatype>
- <datatype>
<name name="option"></name>
</datatype>
<datatype>
@@ -88,9 +64,6 @@
<name name="token"></name>
</datatype>
<datatype>
- <name name="token_info"></name>
- </datatype>
- <datatype>
<name name="tokens"></name>
</datatype>
<datatype>
@@ -122,25 +95,23 @@
<anno>StartLocation</anno>, [])</c>.</p>
<p><c><anno>StartLocation</anno></c> indicates the initial location
when scanning starts. If <c><anno>StartLocation</anno></c> is a line,
- <c>attributes()</c> as well as <c><anno>EndLocation</anno></c> and
+ <c>Anno</c> as well as <c><anno>EndLocation</anno></c> and
<c><anno>ErrorLocation</anno></c> will be lines. If
<c><anno>StartLocation</anno></c> is a pair of a line and a column
- <c>attributes()</c> takes the form of an opaque compound
+ <c>Anno</c> takes the form of an opaque compound
data type, and <c><anno>EndLocation</anno></c> and
<c><anno>ErrorLocation</anno></c>
will be pairs of a line and a column. The <em>token
- attributes</em> contain information about the column and the
+ annotations</em> contain information about the column and the
line where the token begins, as well as the text of the
token (if the <c>text</c> option is given), all of which can
- be accessed by calling <seealso
- marker="#token_info/1">token_info/1,2</seealso>, <seealso
- marker="#attributes_info/1">attributes_info/1,2</seealso>,
+ be accessed by calling
<seealso marker="#column/1">column/1</seealso>,
<seealso marker="#line/1">line/1</seealso>,
<seealso marker="#location/1">location/1</seealso>, and
<seealso marker="#text/1">text/1</seealso>.</p>
<p>A <em>token</em> is a tuple containing information about
- syntactic category, the token attributes, and the actual
+ syntactic category, the token annotations, and the actual
terminal symbol. For punctuation characters (e.g. <c>;</c>,
<c>|</c>) and reserved words, the category and the symbol
coincide, and the token is represented by a two-tuple.
@@ -172,7 +143,7 @@
<item><p>Short for <c>[return_comments, return_white_spaces]</c>.</p>
</item>
<tag><c>text</c></tag>
- <item><p>Include the token's text in the token attributes. The
+ <item><p>Include the token's text in the token annotation. The
text is the part of the input corresponding to the token.</p>
</item>
</taglist>
@@ -306,150 +277,6 @@
</desc>
</func>
<func>
- <name name="token_info" arity="1"/>
- <fsummary>Return information about a token</fsummary>
- <desc>
- <p>Returns a list containing information about the token
- <c><anno>Token</anno></c>. The order of the
- <c><anno>TokenInfoTuple</anno></c>s is not
- defined. See <seealso
- marker="#token_info/2">token_info/2</seealso> for
- information about specific
- <c><anno>TokenInfoTuple</anno></c>s.</p>
- <p>Note that if <c>token_info(Token, TokenItem)</c> returns
- <c>undefined</c> for some <c>TokenItem</c>, the
- item is not included in <c><anno>TokenInfo</anno></c>.</p>
- </desc>
- </func>
- <func>
- <name name="token_info" arity="2" clause_i="1"/>
- <name name="token_info" arity="2" clause_i="2"/>
- <fsummary>Return information about a token</fsummary>
- <type name="token_item"/>
- <type name="attribute_item"/>
- <desc>
- <p>Returns a list containing information about the token
- <c><anno>Token</anno></c>. If one single
- <c><anno>TokenItem</anno></c> is given the returned value is
- the corresponding
- <c>TokenInfoTuple</c>, or <c>undefined</c> if the
- <c>TokenItem</c> has no value. If a list of
- <c><anno>TokenItem</anno></c>s is given the result is a list of
- <c><anno>TokenInfoTuple</anno></c>. The
- <c><anno>TokenInfoTuple</anno></c>s will
- appear with the corresponding <c><anno>TokenItem</anno></c>s in
- the same order as the <c><anno>TokenItem</anno></c>s
- appear in the list of <c>TokenItem</c>s.
- <c><anno>TokenItem</anno></c>s with no value are not included
- in the list of <c><anno>TokenInfoTuple</anno></c>.</p>
- <p>The following <c><anno>TokenInfoTuple</anno></c>s with corresponding
- <c><anno>TokenItem</anno></c>s are valid:</p>
- <taglist>
- <tag><c>{category, </c><seealso marker="#type-category">
- category()</seealso><c>}</c></tag>
- <item><p>The category of the token.</p>
- </item>
- <tag><c>{column, </c><seealso marker="#type-column">
- column()</seealso><c>}</c></tag>
- <item><p>The column where the token begins.</p>
- </item>
- <tag><c>{length, integer() > 0}</c></tag>
- <item><p>The length of the token's text.</p>
- </item>
- <tag><c>{line, </c><seealso marker="#type-line">
- line()</seealso><c>}</c></tag>
- <item><p>The line where the token begins.</p>
- </item>
- <tag><c>{location, </c><seealso marker="#type-location">
- location()</seealso><c>}</c></tag>
- <item><p>The line and column where the token begins, or
- just the line if the column unknown.</p>
- </item>
- <tag><c>{symbol, </c><seealso marker="#type-symbol">
- symbol()</seealso><c>}</c></tag>
- <item><p>The token's symbol.</p>
- </item>
- <tag><c>{text, string()}</c></tag>
- <item><p>The token's text.</p>
- </item>
- </taglist>
- </desc>
- </func>
- <func>
- <name name="attributes_info" arity="1"/>
- <fsummary>Return information about token attributes</fsummary>
- <desc>
- <p>Returns a list containing information about the token
- attributes <c><anno>Attributes</anno></c>. The order of the
- <c><anno>AttributeInfoTuple</anno></c>s is not defined.
- See <seealso
- marker="#attributes_info/2">attributes_info/2</seealso> for
- information about specific
- <c><anno>AttributeInfoTuple</anno></c>s.</p>
- <p>Note that if <c>attributes_info(Token, AttributeItem)</c>
- returns <c>undefined</c> for some <c>AttributeItem</c> in
- the list above, the item is not included in
- <c><anno>AttributesInfo</anno></c>.</p>
- </desc>
- </func>
- <func>
- <name name="attributes_info" arity="2" clause_i="1"/>
- <name name="attributes_info" arity="2" clause_i="2"/>
- <fsummary>Return information about a token attributes</fsummary>
- <type name="attribute_item"/>
- <desc>
- <p>Returns a list containing information about the token
- attributes <c><anno>Attributes</anno></c>. If one single
- <c><anno>AttributeItem</anno></c> is given the returned value is the
- corresponding <c><anno>AttributeInfoTuple</anno></c>,
- or <c>undefined</c> if the <c><anno>AttributeItem</anno></c>
- has no value. If a list of <c><anno>AttributeItem</anno></c>
- is given the result is a list of
- <c><anno>AttributeInfoTuple</anno></c>.
- The <c><anno>AttributeInfoTuple</anno></c>s
- will appear with the corresponding <c><anno>AttributeItem</anno></c>s
- in the same order as the <c><anno>AttributeItem</anno></c>s
- appear in the list of <c><anno>AttributeItem</anno></c>s.
- <c><anno>AttributeItem</anno></c>s with no
- value are not included in the list of
- <c><anno>AttributeInfoTuple</anno></c>.</p>
- <p>The following <c><anno>AttributeInfoTuple</anno></c>s with
- corresponding <c><anno>AttributeItem</anno></c>s are valid:</p>
- <taglist>
- <tag><c>{column, </c><seealso marker="#type-column">
- column()</seealso><c>}</c></tag>
- <item><p>The column where the token begins.</p>
- </item>
- <tag><c>{length, integer() > 0}</c></tag>
- <item><p>The length of the token's text.</p>
- </item>
- <tag><c>{line, </c><seealso marker="#type-line">
- line()</seealso><c>}</c></tag>
- <item><p>The line where the token begins.</p>
- </item>
- <tag><c>{location, </c><seealso marker="#type-location">
- location()</seealso><c>}</c></tag>
- <item><p>The line and column where the token begins, or
- just the line if the column unknown.</p>
- </item>
- <tag><c>{text, string()}</c></tag>
- <item><p>The token's text.</p>
- </item>
- </taglist>
- </desc>
- </func>
- <func>
- <name name="set_attribute" arity="3"/>
- <fsummary>Set a token attribute value</fsummary>
- <desc>
- <p>Sets the value of the <c>line</c> attribute of the token
- attributes <c><anno>Attributes</anno></c>.</p>
- <p>The <c><anno>SetAttributeFun</anno></c> is called with the value of
- the <c>line</c> attribute, and is to return the new value of
- the <c>line</c> attribute.</p>
- </desc>
- </func>
- <func>
<name name="format_error" arity="1"/>
<fsummary>Format an error descriptor</fsummary>
<desc>
diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl
index 529ae30862..c2e345763a 100644
--- a/lib/stdlib/examples/erl_id_trans.erl
+++ b/lib/stdlib/examples/erl_id_trans.erl
@@ -18,11 +18,11 @@
%%
-module(erl_id_trans).
-%% A identity transformer of Erlang abstract syntax.
+%% An identity transformer of Erlang abstract syntax.
%% This module only traverses legal Erlang code. This is most noticeable
%% in guards where only a limited number of expressions are allowed.
-%% N.B. if this module is to be used as a basis for tranforms then
+%% N.B. if this module is to be used as a basis for transforms then
%% all the error cases must be handled otherwise this module just crashes!
-export([parse_transform/2]).
@@ -53,6 +53,17 @@ form({attribute,Line,export,Es0}) ->
form({attribute,Line,import,{Mod,Is0}}) ->
Is1 = farity_list(Is0),
{attribute,Line,import,{Mod,Is1}};
+form({attribute,Line,export_type,Es0}) ->
+ Es1 = farity_list(Es0),
+ {attribute,Line,export_type,Es1};
+form({attribute,Line,optional_callbacks,Es0}) ->
+ try farity_list(Es0) of
+ Es1 ->
+ {attribute,Line,optional_callbacks,Es1}
+ catch
+ _:_ ->
+ {attribute,Line,optional_callbacks,Es0}
+ end;
form({attribute,Line,compile,C}) ->
{attribute,Line,compile,C};
form({attribute,Line,record,{Name,Defs0}}) ->
@@ -60,14 +71,28 @@ form({attribute,Line,record,{Name,Defs0}}) ->
{attribute,Line,record,{Name,Defs1}};
form({attribute,Line,asm,{function,N,A,Code}}) ->
{attribute,Line,asm,{function,N,A,Code}};
+form({attribute,Line,type,{N,T,Vs}}) ->
+ T1 = type(T),
+ Vs1 = variable_list(Vs),
+ {attribute,Line,type,{N,T1,Vs1}};
+form({attribute,Line,opaque,{N,T,Vs}}) ->
+ T1 = type(T),
+ Vs1 = variable_list(Vs),
+ {attribute,Line,opaque,{N,T1,Vs1}};
+form({attribute,Line,spec,{{N,A},FTs}}) ->
+ FTs1 = function_type_list(FTs),
+ {attribute,Line,spec,{{N,A},FTs1}};
+form({attribute,Line,spec,{{M,N,A},FTs}}) ->
+ FTs1 = function_type_list(FTs),
+ {attribute,Line,spec,{{M,N,A},FTs1}};
+form({attribute,Line,callback,{{N,A},FTs}}) ->
+ FTs1 = function_type_list(FTs),
+ {attribute,Line,callback,{{N,A},FTs1}};
form({attribute,Line,Attr,Val}) -> %The general attribute.
{attribute,Line,Attr,Val};
form({function,Line,Name0,Arity0,Clauses0}) ->
{Name,Arity,Clauses} = function(Name0, Arity0, Clauses0),
{function,Line,Name,Arity,Clauses};
-% Mnemosyne, ignore...
-form({rule,Line,Name,Arity,Body}) ->
- {rule,Line,Name,Arity,Body}; % Dont dig into this
%% Extra forms from the parser.
form({error,E}) -> {error,E};
form({warning,W}) -> {warning,W};
@@ -79,6 +104,12 @@ farity_list([{Name,Arity}|Fas]) ->
[{Name,Arity}|farity_list(Fas)];
farity_list([]) -> [].
+%% -type variable_list([Var]) -> [Var]
+
+variable_list([{var,Line,Var}|Vs]) ->
+ [{var,Line,Var}|variable_list(Vs)];
+variable_list([]) -> [].
+
%% -type record_defs([RecDef]) -> [RecDef].
%% N.B. Field names are full expressions here but only atoms are allowed
%% by the *parser*!
@@ -88,6 +119,16 @@ record_defs([{record_field,Line,{atom,La,A},Val0}|Is]) ->
[{record_field,Line,{atom,La,A},Val1}|record_defs(Is)];
record_defs([{record_field,Line,{atom,La,A}}|Is]) ->
[{record_field,Line,{atom,La,A}}|record_defs(Is)];
+record_defs([{typed_record_field,{record_field,Line,{atom,La,A},Val0},Type}|
+ Is]) ->
+ Val1 = expr(Val0),
+ Type1 = type(Type),
+ [{typed_record_field,{record_field,Line,{atom,La,A},Val1},Type1}|
+ record_defs(Is)];
+record_defs([{typed_record_field,{record_field,Line,{atom,La,A}},Type}|Is]) ->
+ Type1 = type(Type),
+ [{typed_record_field,{record_field,Line,{atom,La,A}},Type1}|
+ record_defs(Is)];
record_defs([]) -> [].
%% -type function(atom(), integer(), [Clause]) -> {atom(),integer(),[Clause]}.
@@ -196,9 +237,9 @@ pattern_grp([]) ->
bit_types([]) ->
[];
-bit_types([Atom | Rest]) when atom(Atom) ->
+bit_types([Atom | Rest]) when is_atom(Atom) ->
[Atom | bit_types(Rest)];
-bit_types([{Atom, Integer} | Rest]) when atom(Atom), integer(Integer) ->
+bit_types([{Atom, Integer} | Rest]) when is_atom(Atom), is_integer(Integer) ->
[{Atom, Integer} | bit_types(Rest)].
@@ -226,7 +267,7 @@ pattern_fields([]) -> [].
%% -type guard([GuardTest]) -> [GuardTest].
-guard([G0|Gs]) when list(G0) ->
+guard([G0|Gs]) when is_list(G0) ->
[guard0(G0) | guard(Gs)];
guard(L) ->
guard0(L).
@@ -547,3 +588,97 @@ fun_clauses([C0|Cs]) ->
C1 = clause(C0),
[C1|fun_clauses(Cs)];
fun_clauses([]) -> [].
+
+function_type_list([{type,Line,bounded_fun,[Ft,Fc]}|Fts]) ->
+ Ft1 = function_type(Ft),
+ Fc1 = function_constraint(Fc),
+ [{type,Line,bounded_fun,[Ft1,Fc1]}|function_type_list(Fts)];
+function_type_list([Ft|Fts]) ->
+ [function_type(Ft)|function_type_list(Fts)];
+function_type_list([]) -> [].
+
+function_type({type,Line,'fun',[{type,Lt,product,As},B]}) ->
+ As1 = type_list(As),
+ B1 = type(B),
+ {type,Line,'fun',[{type,Lt,product,As1},B1]}.
+
+function_constraint([C|Cs]) ->
+ C1 = constraint(C),
+ [C1|function_constraint(Cs)];
+function_constraint([]) -> [].
+
+constraint({type,Line,constraint,[{atom,L,A},[V,T]]}) ->
+ V1 = type(V),
+ T1 = type(T),
+ {type,Line,constraint,[{atom,L,A},[V1,T1]]}.
+
+type({ann_type,Line,[{var,Lv,V},T]}) ->
+ T1 = type(T),
+ {ann_type,Line,[{var,Lv,V},T1]};
+type({atom,Line,A}) ->
+ {atom,Line,A};
+type({integer,Line,I}) ->
+ {integer,Line,I};
+type({op,Line,Op,T}) ->
+ T1 = type(T),
+ {op,Line,Op,T1};
+type({op,Line,Op,L,R}) ->
+ L1 = type(L),
+ R1 = type(R),
+ {op,Line,Op,L1,R1};
+type({type,Line,binary,[M,N]}) ->
+ M1 = type(M),
+ N1 = type(N),
+ {type,Line,binary,[M1,N1]};
+type({type,Line,'fun',[]}) ->
+ {type,Line,'fun',[]};
+type({type,Line,'fun',[{type,Lt,any},B]}) ->
+ B1 = type(B),
+ {type,Line,'fun',[{type,Lt,any},B1]};
+type({type,Line,range,[L,H]}) ->
+ L1 = type(L),
+ H1 = type(H),
+ {type,Line,range,[L1,H1]};
+type({type,Line,map,any}) ->
+ {type,Line,map,any};
+type({type,Line,map,Ps}) ->
+ Ps1 = map_pair_types(Ps),
+ {type,Line,map,Ps1};
+type({type,Line,record,[{atom,La,N}|Fs]}) ->
+ Fs1 = field_types(Fs),
+ {type,Line,record,[{atom,La,N}|Fs1]};
+type({remote_type,Line,[{atom,Lm,M},{atom,Ln,N},As]}) ->
+ As1 = type_list(As),
+ {remote_type,Line,[{atom,Lm,M},{atom,Ln,N},As1]};
+type({type,Line,tuple,any}) ->
+ {type,Line,tuple,any};
+type({type,Line,tuple,Ts}) ->
+ Ts1 = type_list(Ts),
+ {type,Line,tuple,Ts1};
+type({type,Line,union,Ts}) ->
+ Ts1 = type_list(Ts),
+ {type,Line,union,Ts1};
+type({var,Line,V}) ->
+ {var,Line,V};
+type({user_type,Line,N,As}) ->
+ As1 = type_list(As),
+ {user_type,Line,N,As1};
+type({type,Line,N,As}) ->
+ As1 = type_list(As),
+ {type,Line,N,As1}.
+
+map_pair_types([{type,Line,map_field_assoc,[K,V]}|Ps]) ->
+ K1 = type(K),
+ V1 = type(V),
+ [{type,Line,map_field_assoc,[K1,V1]}|map_pair_types(Ps)];
+map_pair_types([]) -> [].
+
+field_types([{type,Line,field_type,[{atom,La,A},T]}|Fs]) ->
+ T1 = type(T),
+ [{type,Line,field_type,[{atom,La,A},T1]}|field_types(Fs)];
+field_types([]) -> [].
+
+type_list([T|Ts]) ->
+ T1 = type(T),
+ [T1|type_list(Ts)];
+type_list([]) -> [].
diff --git a/lib/stdlib/include/erl_bits.hrl b/lib/stdlib/include/erl_bits.hrl
index 8405a55d55..2a54587a17 100644
--- a/lib/stdlib/include/erl_bits.hrl
+++ b/lib/stdlib/include/erl_bits.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-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.
@@ -26,10 +26,10 @@
-type bt_unit() :: 1..256.
-record(bittype, {
- type :: bt_type(),
- unit :: bt_unit(), %% element unit
- sign :: bt_sign(),
- endian :: bt_endian()
+ type :: bt_type() | 'undefined',
+ unit :: bt_unit() | 'undefined', %% element unit
+ sign :: bt_sign() | 'undefined',
+ endian :: bt_endian() | 'undefined'
}).
-record(bitdefault, {
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index 503a2b416f..7a17226e46 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -872,7 +872,7 @@ mandatory_chunks() ->
%%% can use it.
%%% ====================================================================
--record(state, {crypto_key_f :: crypto_fun()}).
+-record(state, {crypto_key_f :: crypto_fun() | 'undefined'}).
-define(CRYPTO_KEY_SERVER, beam_lib__crypto_key_server).
@@ -904,7 +904,11 @@ anno_from_term({Tag, Forms}) when Tag =:= abstract_v1; Tag =:= abstract_v2 ->
anno_from_term(T) ->
T.
-anno_from_forms(Forms) ->
+anno_from_forms(Forms0) ->
+ %% Forms with record field types created before OTP 19.0 are
+ %% replaced by well-formed record forms holding the type
+ %% information.
+ Forms = epp:restore_typed_record_fields(Forms0),
[erl_parse:anno_from_term(Form) || Form <- Forms].
start_crypto() ->
@@ -975,9 +979,7 @@ handle_call({get_crypto_key, What}, From, #state{crypto_key_f=F}=S) ->
handle_call({crypto_key_fun, F}, {_,_} = From, S) ->
case S#state.crypto_key_f of
undefined ->
- %% Don't allow tuple funs here. (They weren't allowed before,
- %% so there is no reason to allow them now.)
- if is_function(F), is_function(F, 1) ->
+ if is_function(F, 1) ->
{Result, Fun, Reply} =
case catch F(init) of
ok ->
diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl
index af00410572..fb0c395d70 100644
--- a/lib/stdlib/src/binary.erl
+++ b/lib/stdlib/src/binary.erl
@@ -20,7 +20,7 @@
-module(binary).
%%
%% Implemented in this module:
--export([split/2,split/3,replace/3,replace/4]).
+-export([replace/3,replace/4]).
-export_type([cp/0]).
@@ -34,7 +34,8 @@
decode_unsigned/2, encode_unsigned/1, encode_unsigned/2,
first/1, last/1, list_to_bin/1, longest_common_prefix/1,
longest_common_suffix/1, match/2, match/3, matches/2,
- matches/3, part/2, part/3, referenced_byte_size/1]).
+ matches/3, part/2, part/3, referenced_byte_size/1,
+ split/2, split/3]).
-spec at(Subject, Pos) -> byte() when
Subject :: binary(),
@@ -198,19 +199,13 @@ part(_, _, _) ->
referenced_byte_size(_) ->
erlang:nif_error(undef).
-%%% End of BIFs.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% split
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-spec split(Subject, Pattern) -> Parts when
Subject :: binary(),
Pattern :: binary() | [binary()] | cp(),
Parts :: [binary()].
-split(H,N) ->
- split(H,N,[]).
+split(_, _) ->
+ erlang:nif_error(undef).
-spec split(Subject, Pattern, Options) -> Parts when
Subject :: binary(),
@@ -219,53 +214,10 @@ split(H,N) ->
Option :: {scope, part()} | trim | global | trim_all,
Parts :: [binary()].
-split(Haystack,Needles,Options) ->
- try
- {Part,Global,Trim,TrimAll} =
- get_opts_split(Options,{no,false,false,false}),
- Moptlist = case Part of
- no ->
- [];
- {A,B} ->
- [{scope,{A,B}}]
- end,
- MList = if
- Global ->
- binary:matches(Haystack,Needles,Moptlist);
- true ->
- case binary:match(Haystack,Needles,Moptlist) of
- nomatch -> [];
- Match -> [Match]
- end
- end,
- do_split(Haystack,MList,0,Trim,TrimAll)
- catch
- _:_ ->
- erlang:error(badarg)
- end.
-
-do_split(H,[],N,true,_) when N >= byte_size(H) ->
- [];
-do_split(H,[],N,_,true) when N >= byte_size(H) ->
- [];
-do_split(H,[],N,_,_) ->
- [binary:part(H,{N,byte_size(H)-N})];
-do_split(H,[{A,B}|T],N,Trim,TrimAll) ->
- case binary:part(H,{N,A-N}) of
- <<>> when TrimAll == true ->
- do_split(H,T,A+B,Trim,TrimAll);
- <<>> ->
- Rest = do_split(H,T,A+B,Trim,TrimAll),
- case {Trim, Rest} of
- {true,[]} ->
- [];
- _ ->
- [<<>> | Rest]
- end;
- Oth ->
- [Oth | do_split(H,T,A+B,Trim,TrimAll)]
- end.
+split(_, _, _) ->
+ erlang:nif_error(undef).
+%%% End of BIFs.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% replace
@@ -352,19 +304,6 @@ splitat(H,N,[I|T]) ->
%% Simple helper functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_opts_split([],{Part,Global,Trim,TrimAll}) ->
- {Part,Global,Trim,TrimAll};
-get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim,TrimAll}) ->
- get_opts_split(T,{{A,B},Global,Trim,TrimAll});
-get_opts_split([global | T],{Part,_Global,Trim,TrimAll}) ->
- get_opts_split(T,{Part,true,Trim,TrimAll});
-get_opts_split([trim | T],{Part,Global,_Trim,TrimAll}) ->
- get_opts_split(T,{Part,Global,true,TrimAll});
-get_opts_split([trim_all | T],{Part,Global,Trim,_TrimAll}) ->
- get_opts_split(T,{Part,Global,Trim,true});
-get_opts_split(_,_) ->
- throw(badopt).
-
get_opts_replace([],{Part,Global,Insert}) ->
{Part,Global,Insert};
get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) ->
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index 2d037ff795..bf22949870 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
+%% 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.
@@ -1124,7 +1124,9 @@ repl({delayed_write, {Delay,Size} = C}, Defs)
Defs#open_args{delayed_write = C};
repl({estimated_no_objects, I}, Defs) ->
repl({min_no_slots, I}, Defs);
-repl({file, File}, Defs) ->
+repl({file, File}, Defs) when is_list(File) ->
+ Defs#open_args{file = File};
+repl({file, File}, Defs) when is_atom(File) ->
Defs#open_args{file = to_list(File)};
repl({keypos, P}, Defs) when is_integer(P), P > 0 ->
Defs#open_args{keypos =P};
@@ -1289,7 +1291,15 @@ init(Parent, Server) ->
open_file_loop(#head{parent = Parent, server = Server}).
open_file_loop(Head) ->
- open_file_loop(Head, 0).
+ %% The Dets server pretends the file is open before
+ %% internal_open() has been called, which means that unless the
+ %% internal_open message is applied first, other processes can
+ %% find the pid by calling dets_server:get_pid() and do things
+ %% before Head has been initialized properly.
+ receive
+ ?DETS_CALL(From, {internal_open, _Ref, _Args}=Op) ->
+ do_apply_op(Op, From, Head, 0)
+ end.
open_file_loop(Head, N) when element(1, Head#head.update_mode) =:= error ->
open_file_loop2(Head, N);
diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl
index d3124ac593..936c095aef 100644
--- a/lib/stdlib/src/epp.erl
+++ b/lib/stdlib/src/epp.erl
@@ -40,16 +40,21 @@
-type ifdef() :: 'ifdef' | 'ifndef' | 'else'.
--type name() :: {'atom', atom()}.
+-type name() :: atom().
-type argspec() :: 'none' %No arguments
| non_neg_integer(). %Number of arguments
-type tokens() :: [erl_scan:token()].
-type used() :: {name(), argspec()}.
+-type function_name_type() :: 'undefined'
+ | {atom(),non_neg_integer()}
+ | tokens().
+
-define(DEFAULT_ENCODING, utf8).
%% Epp state record.
--record(epp, {file :: file:io_device(), %Current file
+-record(epp, {file :: file:io_device()
+ | 'undefined', %Current file
location=1, %Current location
delta=0 :: non_neg_integer(), %Offset from Location (-file)
name="" :: file:name(), %Current file name
@@ -57,21 +62,15 @@
istk=[] :: [ifdef()], %Ifdef stack
sstk=[] :: [#epp{}], %State stack
path=[] :: [file:name()], %Include-path
- macs = dict:new() %Macros (don't care locations)
- :: dict:dict(name(), {argspec(), tokens()}),
- uses = dict:new() %Macro use structure
- :: dict:dict(name(), [{argspec(), [used()]}]),
+ macs = #{} %Macros (don't care locations)
+ :: #{name() => {argspec(), tokens()}},
+ uses = #{} %Macro use structure
+ :: #{name() => [{argspec(), [used()]}]},
default_encoding = ?DEFAULT_ENCODING :: source_encoding(),
- pre_opened = false :: boolean()
+ pre_opened = false :: boolean(),
+ fname = [] :: function_name_type()
}).
-%%% Note on representation: as tokens, both {var, Location, Name} and
-%%% {atom, Location, Name} can occur as macro identifiers. However, keeping
-%%% this distinction here is done for historical reasons only: previously,
-%%% ?FOO and ?'FOO' were not the same, but now they are. Removing the
-%%% distinction in the internal representation would simplify the code
-%%% a little.
-
%% open(Options)
%% open(FileName, IncludePath)
%% open(FileName, IncludePath, PreDefMacros)
@@ -211,6 +210,10 @@ format_error({include,W,F}) ->
io_lib:format("can't find include ~s \"~s\"", [W,F]);
format_error({illegal,How,What}) ->
io_lib:format("~s '-~s'", [How,What]);
+format_error({illegal_function,Macro}) ->
+ io_lib:format("?~s can only be used within a function", [Macro]);
+format_error({illegal_function_usage,Macro}) ->
+ io_lib:format("?~s must not begin a form", [Macro]);
format_error({'NYI',What}) ->
io_lib:format("not yet implemented '~s'", [What]);
format_error(E) -> file:format_error(E).
@@ -264,20 +267,7 @@ parse_file(Ifile, Options) ->
parse_file(Epp) ->
case parse_erl_form(Epp) of
{ok,Form} ->
- case Form of
- {attribute,La,record,{Record, Fields}} ->
- case normalize_typed_record_fields(Fields) of
- {typed, NewFields} ->
- [{attribute, La, record, {Record, NewFields}},
- {attribute, La, type,
- {{record, Record}, Fields, []}}
- |parse_file(Epp)];
- not_typed ->
- [Form|parse_file(Epp)]
- end;
- _ ->
- [Form|parse_file(Epp)]
- end;
+ [Form|parse_file(Epp)];
{error,E} ->
[{error,E}|parse_file(Epp)];
{eof,Location} ->
@@ -549,7 +539,8 @@ init_server(Pid, Name, Options, St0) ->
default_encoding=DefEncoding},
From = wait_request(St),
Anno = erl_anno:new(AtLocation),
- enter_file_reply(From, Name, Anno, AtLocation, code),
+ enter_file_reply(From, file_name(Name), Anno,
+ AtLocation, code),
wait_req_scan(St);
{error,E} ->
epp_reply(Pid, {error,E})
@@ -560,18 +551,20 @@ init_server(Pid, Name, Options, St0) ->
%% FILE, LINE, MODULE as undefined, MACHINE and MACHINE value.
predef_macros(File) ->
- Machine = list_to_atom(erlang:system_info(machine)),
- Anno = line1(),
- dict:from_list([
- {{atom,'FILE'}, {none,[{string,Anno,File}]}},
- {{atom,'LINE'}, {none,[{integer,Anno,1}]}},
- {{atom,'MODULE'}, undefined},
- {{atom,'MODULE_STRING'}, undefined},
- {{atom,'BASE_MODULE'}, undefined},
- {{atom,'BASE_MODULE_STRING'}, undefined},
- {{atom,'MACHINE'}, {none,[{atom,Anno,Machine}]}},
- {{atom,Machine}, {none,[{atom,Anno,true}]}}
- ]).
+ Machine = list_to_atom(erlang:system_info(machine)),
+ Anno = line1(),
+ Defs = [{'FILE', {none,[{string,Anno,File}]}},
+ {'FUNCTION_NAME', undefined},
+ {'FUNCTION_ARITY', undefined},
+ {'LINE', {none,[{integer,Anno,1}]}},
+ {'MODULE', undefined},
+ {'MODULE_STRING', undefined},
+ {'BASE_MODULE', undefined},
+ {'BASE_MODULE_STRING', undefined},
+ {'MACHINE', {none,[{atom,Anno,Machine}]}},
+ {Machine, {none,[{atom,Anno,true}]}}
+ ],
+ maps:from_list(Defs).
%% user_predef(PreDefMacros, Macros) ->
%% {ok,MacroDict} | {error,E}
@@ -580,28 +573,21 @@ predef_macros(File) ->
user_predef([{M,Val,redefine}|Pdm], Ms) when is_atom(M) ->
Exp = erl_parse:tokens(erl_parse:abstract(Val)),
- user_predef(Pdm, dict:store({atom,M}, {none,Exp}, Ms));
+ user_predef(Pdm, Ms#{M=>{none,Exp}});
user_predef([{M,Val}|Pdm], Ms) when is_atom(M) ->
- case dict:find({atom,M}, Ms) of
- {ok,_Defs} when is_list(_Defs) -> %% User defined macros
+ case Ms of
+ #{M:=Defs} when is_list(Defs) ->
+ %% User defined macros.
{error,{redefine,M}};
- {ok,_Def} -> %% Predefined macros
+ #{M:=_Defs} ->
+ %% Predefined macros.
{error,{redefine_predef,M}};
- error ->
+ _ ->
Exp = erl_parse:tokens(erl_parse:abstract(Val)),
- user_predef(Pdm, dict:store({atom,M}, [{none, {none,Exp}}], Ms))
+ user_predef(Pdm, Ms#{M=>[{none,{none,Exp}}]})
end;
user_predef([M|Pdm], Ms) when is_atom(M) ->
- case dict:find({atom,M}, Ms) of
- {ok,_Defs} when is_list(_Defs) -> %% User defined macros
- {error,{redefine,M}};
- {ok,_Def} -> %% Predefined macros
- {error,{redefine_predef,M}};
- error ->
- A = line1(),
- user_predef(Pdm,
- dict:store({atom,M}, [{none, {none,[{atom,A,true}]}}], Ms))
- end;
+ user_predef([{M,true}|Pdm], Ms);
user_predef([Md|_Pdm], _Ms) -> {error,{bad,Md}};
user_predef([], Ms) -> {ok,Ms}.
@@ -615,7 +601,9 @@ wait_request(St) ->
receive
{epp_request,From,scan_erl_form} -> From;
{epp_request,From,macro_defs} ->
- epp_reply(From, dict:to_list(St#epp.macs)),
+ %% Return the old format to avoid any incompability issues.
+ Defs = [{{atom,K},V} || {K,V} <- maps:to_list(St#epp.macs)],
+ epp_reply(From, Defs),
wait_request(St);
{epp_request,From,close} ->
close_file(St),
@@ -667,7 +655,8 @@ enter_file(NewName, Inc, From, St) ->
enter_file2(NewF, Pname, From, St0, AtLocation) ->
Anno = erl_anno:new(AtLocation),
enter_file_reply(From, Pname, Anno, AtLocation, code),
- Ms = dict:store({atom,'FILE'}, {none,[{string,Anno,Pname}]}, St0#epp.macs),
+ Ms0 = St0#epp.macs,
+ Ms = Ms0#{'FILE':={none,[{string,Anno,Pname}]}},
%% update the head of the include path to be the directory of the new
%% source file, so that an included file can always include other files
%% relative to its current location (this is also how C does it); note
@@ -688,7 +677,7 @@ enter_file_reply(From, Name, LocationAnno, AtLocation, Where) ->
generated -> erl_anno:set_generated(true, Anno0)
end,
Rep = {ok, [{'-',Anno},{atom,Anno,file},{'(',Anno},
- {string,Anno,file_name(Name)},{',',Anno},
+ {string,Anno,Name},{',',Anno},
{integer,Anno,get_line(LocationAnno)},{')',LocationAnno},
{dot,Anno}]},
epp_reply(From, Rep).
@@ -719,9 +708,8 @@ leave_file(From, St) ->
name2=OldName2} = OldSt,
CurrLoc = add_line(OldLoc, Delta),
Anno = erl_anno:new(CurrLoc),
- Ms = dict:store({atom,'FILE'},
- {none,[{string,Anno,OldName2}]},
- St#epp.macs),
+ Ms0 = St#epp.macs,
+ Ms = Ms0#{'FILE':={none,[{string,Anno,OldName2}]}},
NextSt = OldSt#epp{sstk=Sts,macs=Ms,uses=St#epp.uses},
enter_file_reply(From, OldName, Anno, CurrLoc, code),
case OldName2 =:= OldName of
@@ -778,7 +766,7 @@ scan_toks([{'-',_Lh},{atom,_Le,elif}=Elif|Toks], From, St) ->
scan_toks([{'-',_Lh},{atom,_Le,endif}=Endif|Toks], From, St) ->
scan_endif(Toks, Endif, From, St);
scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) ->
- case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of
+ case catch expand_macros(Toks0, St) of
Toks1 when is_list(Toks1) ->
scan_file(Toks1, FileToken, From, St);
{error,ErrL,What} ->
@@ -786,7 +774,7 @@ scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) ->
wait_req_scan(St)
end;
scan_toks(Toks0, From, St) ->
- case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of
+ case catch expand_macros(Toks0, St#epp{fname=Toks0}) of
Toks1 when is_list(Toks1) ->
epp_reply(From, {ok,Toks1}),
wait_req_scan(St#epp{macs=scan_module(Toks1, St#epp.macs)});
@@ -796,91 +784,48 @@ scan_toks(Toks0, From, St) ->
end.
scan_module([{'-',_Lh},{atom,_Lm,module},{'(',_Ll}|Ts], Ms) ->
- scan_module_1(Ts, [], Ms);
+ scan_module_1(Ts, Ms);
scan_module([{'-',_Lh},{atom,_Lm,extends},{'(',_Ll}|Ts], Ms) ->
- scan_extends(Ts, [], Ms);
+ scan_extends(Ts, Ms);
scan_module(_Ts, Ms) -> Ms.
-scan_module_1([{atom,_,_}=A,{',',L}|Ts], As, Ms) ->
+scan_module_1([{atom,_,_}=A,{',',L}|Ts], Ms) ->
%% Parameterized modules.
- scan_module_1([A,{')',L}|Ts], As, Ms);
-scan_module_1([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) ->
- Mod = lists:concat(lists:reverse([A|As])),
- Ms = dict:store({atom,'MODULE'},
- {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0),
- dict:store({atom,'MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms);
-scan_module_1([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) ->
- scan_module_1(Ts, [".",A|As], Ms);
-scan_module_1([{'.',_Lr}|Ts], As, Ms) ->
- scan_module_1(Ts, As, Ms);
-scan_module_1(_Ts, _As, Ms) -> Ms.
-
-scan_extends([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) ->
- Mod = lists:concat(lists:reverse([A|As])),
- Ms = dict:store({atom,'BASE_MODULE'},
- {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0),
- dict:store({atom,'BASE_MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms);
-scan_extends([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) ->
- scan_extends(Ts, [".",A|As], Ms);
-scan_extends([{'.',_Lr}|Ts], As, Ms) ->
- scan_extends(Ts, As, Ms);
-scan_extends(_Ts, _As, Ms) -> Ms.
+ scan_module_1([A,{')',L}|Ts], Ms);
+scan_module_1([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) ->
+ ModString = atom_to_list(A),
+ Ms = Ms0#{'MODULE':={none,[ModAtom]}},
+ Ms#{'MODULE_STRING':={none,[{string,Ln,ModString}]}};
+scan_module_1(_Ts, Ms) -> Ms.
+
+scan_extends([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) ->
+ ModString = atom_to_list(A),
+ Ms = Ms0#{'BASE_MODULE':={none,[ModAtom]}},
+ Ms#{'BASE_MODULE_STRING':={none,[{string,Ln,ModString}]}};
+scan_extends(_Ts, Ms) -> Ms.
%% scan_define(Tokens, DefineToken, From, EppState)
-scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',_}=Comma|Toks], _Def, From, St)
+scan_define([{'(',_Lp},{Type,_Lm,_}=Mac|Toks], Def, From, St)
when Type =:= atom; Type =:= var ->
+ scan_define_1(Toks, Mac, Def, From, St);
+scan_define(_Toks, Def, From, St) ->
+ epp_reply(From, {error,{loc(Def),epp,{bad,define}}}),
+ wait_req_scan(St).
+
+scan_define_1([{',',_}=Comma|Toks], Mac,_Def, From, St) ->
case catch macro_expansion(Toks, Comma) of
Expansion when is_list(Expansion) ->
- case dict:find({atom,M}, St#epp.macs) of
- {ok, Defs} when is_list(Defs) ->
- %% User defined macros: can be overloaded
- case proplists:is_defined(none, Defs) of
- true ->
- epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}),
- wait_req_scan(St);
- false ->
- scan_define_cont(From, St,
- {atom, M},
- {none, {none,Expansion}})
- end;
- {ok, _PreDef} ->
- %% Predefined macros: cannot be overloaded
- epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}),
- wait_req_scan(St);
- error ->
- scan_define_cont(From, St,
- {atom, M},
- {none, {none,Expansion}})
- end;
+ scan_define_2(none, {none,Expansion}, Mac, From, St);
{error,ErrL,What} ->
epp_reply(From, {error,{ErrL,epp,What}}),
wait_req_scan(St)
end;
-scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St)
- when Type =:= atom; Type =:= var ->
+scan_define_1([{'(',_Lc}|Toks], Mac, Def, From, St) ->
case catch macro_pars(Toks, []) of
- {ok, {As,Me}} ->
+ {ok,{As,_}=MacroDef} ->
Len = length(As),
- case dict:find({atom,M}, St#epp.macs) of
- {ok, Defs} when is_list(Defs) ->
- %% User defined macros: can be overloaded
- case proplists:is_defined(Len, Defs) of
- true ->
- epp_reply(From,{error,{loc(Mac),epp,{redefine,M}}}),
- wait_req_scan(St);
- false ->
- scan_define_cont(From, St, {atom, M},
- {Len, {As, Me}})
- end;
- {ok, _PreDef} ->
- %% Predefined macros: cannot be overloaded
- %% (There are currently no predefined F(...) macros.)
- epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}),
- wait_req_scan(St);
- error ->
- scan_define_cont(From, St, {atom, M}, {Len, {As, Me}})
- end;
+ scan_define_2(Len, MacroDef, Mac, From, St);
{error,ErrL,What} ->
epp_reply(From, {error,{ErrL,epp,What}}),
wait_req_scan(St);
@@ -888,10 +833,29 @@ scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St)
epp_reply(From, {error,{loc(Def),epp,{bad,define}}}),
wait_req_scan(St)
end;
-scan_define(_Toks, Def, From, St) ->
+scan_define_1(_Toks, _Mac, Def, From, St) ->
epp_reply(From, {error,{loc(Def),epp,{bad,define}}}),
wait_req_scan(St).
+scan_define_2(Arity, Def, {_,_,Key}=Mac, From, #epp{macs=Ms}=St) ->
+ case Ms of
+ #{Key:=Defs} when is_list(Defs) ->
+ %% User defined macros: can be overloaded
+ case proplists:is_defined(Arity, Defs) of
+ true ->
+ epp_reply(From, {error,{loc(Mac),epp,{redefine,Key}}}),
+ wait_req_scan(St);
+ false ->
+ scan_define_cont(From, St, Key, Defs, Arity, Def)
+ end;
+ #{Key:=_} ->
+ %% Predefined macros: cannot be overloaded
+ epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,Key}}}),
+ wait_req_scan(St);
+ _ ->
+ scan_define_cont(From, St, Key, [], Arity, Def)
+ end.
+
%%% Detection of circular macro expansions (which would either keep
%%% the compiler looping forever, or run out of memory):
%%% When a macro is defined, we store the names of other macros it
@@ -901,11 +865,17 @@ scan_define(_Toks, Def, From, St) ->
%%% the information from St#epp.uses is traversed, and if a circularity
%%% is detected, an error message is thrown.
-scan_define_cont(F, St, M, {Arity, Def}) ->
- Ms = dict:append_list(M, [{Arity, Def}], St#epp.macs),
- try dict:append_list(M, [{Arity, macro_uses(Def)}], St#epp.uses) of
+scan_define_cont(F, #epp{macs=Ms0}=St, M, Defs, Arity, Def) ->
+ Ms = Ms0#{M=>[{Arity,Def}|Defs]},
+ try macro_uses(Def) of
U ->
- scan_toks(F, St#epp{uses=U, macs=Ms})
+ Uses0 = St#epp.uses,
+ Val = [{Arity,U}|case Uses0 of
+ #{M:=UseList} -> UseList;
+ _ -> []
+ end],
+ Uses = Uses0#{M=>Val},
+ scan_toks(F, St#epp{uses=Uses,macs=Ms})
catch
{error, Line, Reason} ->
epp_reply(F, {error,{Line,epp,Reason}}),
@@ -923,23 +893,23 @@ macro_ref([{'?', _}, {'?', _} | Rest]) ->
macro_ref([{'?', _}, {atom, _, A}=Atom | Rest]) ->
Lm = loc(Atom),
Arity = count_args(Rest, Lm, A),
- [{{atom, A}, Arity} | macro_ref(Rest)];
+ [{A,Arity} | macro_ref(Rest)];
macro_ref([{'?', _}, {var, _, A}=Var | Rest]) ->
Lm = loc(Var),
Arity = count_args(Rest, Lm, A),
- [{{atom, A}, Arity} | macro_ref(Rest)];
+ [{A,Arity} | macro_ref(Rest)];
macro_ref([_Token | Rest]) ->
macro_ref(Rest).
%% scan_undef(Tokens, UndefToken, From, EppState)
scan_undef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From, St) ->
- Macs = dict:erase({atom,M}, St#epp.macs),
- Uses = dict:erase({atom,M}, St#epp.uses),
+ Macs = maps:remove(M, St#epp.macs),
+ Uses = maps:remove(M, St#epp.uses),
scan_toks(From, St#epp{macs=Macs, uses=Uses});
scan_undef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From,St) ->
- Macs = dict:erase({atom,M}, St#epp.macs),
- Uses = dict:erase({atom,M}, St#epp.uses),
+ Macs = maps:remove(M, St#epp.macs),
+ Uses = maps:remove(M, St#epp.uses),
scan_toks(From, St#epp{macs=Macs, uses=Uses});
scan_undef(_Toks, Undef, From, St) ->
epp_reply(From, {error,{loc(Undef),epp,{bad,undef}}}),
@@ -1006,17 +976,17 @@ scan_include_lib(_Toks, Inc, From, St) ->
%% Report a badly formed if[n]def test and then treat as undefined macro.
scan_ifdef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) ->
- case dict:find({atom,M}, St#epp.macs) of
- {ok,_Def} ->
+ case St#epp.macs of
+ #{M:=_Def} ->
scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]});
- error ->
+ _ ->
skip_toks(From, St, [ifdef])
end;
scan_ifdef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) ->
- case dict:find({atom,M}, St#epp.macs) of
- {ok,_Def} ->
+ case St#epp.macs of
+ #{M:=_Def} ->
scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]});
- error ->
+ _ ->
skip_toks(From, St, [ifdef])
end;
scan_ifdef(_Toks, IfDef, From, St) ->
@@ -1024,17 +994,17 @@ scan_ifdef(_Toks, IfDef, From, St) ->
wait_req_skip(St, [ifdef]).
scan_ifndef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) ->
- case dict:find({atom,M}, St#epp.macs) of
- {ok,_Def} ->
+ case St#epp.macs of
+ #{M:=_Def} ->
skip_toks(From, St, [ifndef]);
- error ->
+ _ ->
scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]})
end;
scan_ifndef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) ->
- case dict:find({atom,M}, St#epp.macs) of
- {ok,_Def} ->
+ case St#epp.macs of
+ #{M:=_Def} ->
skip_toks(From, St, [ifndef]);
- error ->
+ _ ->
scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]})
end;
scan_ifndef(_Toks, IfnDef, From, St) ->
@@ -1102,7 +1072,8 @@ scan_file([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp},
{dot,_Ld}], Tf, From, St) ->
Anno = erl_anno:new(Ln),
enter_file_reply(From, Name, Anno, loc(Tf), generated),
- Ms = dict:store({atom,'FILE'}, {none,[{string,line1(),Name}]}, St#epp.macs),
+ Ms0 = St#epp.macs,
+ Ms = Ms0#{'FILE':={none,[{string,line1(),Name}]}},
Locf = loc(Tf),
NewLoc = new_location(Ln, St#epp.location, Locf),
Delta = get_line(element(2, Tf))-Ln + St#epp.delta,
@@ -1185,45 +1156,47 @@ macro_expansion([T|Ts], _Anno0) ->
[T|macro_expansion(Ts, T)];
macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}).
-%% expand_macros(Tokens, Macros)
+%% expand_macros(Tokens, St)
%% expand_macro(Tokens, MacroToken, RestTokens)
%% Expand the macros in a list of tokens, making sure that an expansion
%% gets the same location as the macro call.
-expand_macros(Type, MacT, M, Toks, Ms0) ->
- %% (Type will always be 'atom')
- {Ms, U} = Ms0,
+expand_macros(MacT, M, Toks, St) ->
+ #epp{macs=Ms,uses=U} = St,
Lm = loc(MacT),
Tinfo = element(2, MacT),
- case expand_macro1(Type, Lm, M, Toks, Ms) of
+ case expand_macro1(Lm, M, Toks, Ms) of
{ok,{none,Exp}} ->
- check_uses([{{Type,M}, none}], [], U, Lm),
- Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], dict:new()), Ms0),
- expand_macros(Toks1++Toks, Ms0);
+ check_uses([{M,none}], [], U, Lm),
+ Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], #{}), St),
+ expand_macros(Toks1++Toks, St);
{ok,{As,Exp}} ->
- check_uses([{{Type,M}, length(As)}], [], U, Lm),
- {Bs,Toks1} = bind_args(Toks, Lm, M, As, dict:new()),
- expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), Ms0)
+ check_uses([{M,length(As)}], [], U, Lm),
+ {Bs,Toks1} = bind_args(Toks, Lm, M, As, #{}),
+ expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), St)
end.
-expand_macro1(Type, Lm, M, Toks, Ms) ->
+expand_macro1(Lm, M, Toks, Ms) ->
Arity = count_args(Toks, Lm, M),
- case dict:find({Type,M}, Ms) of
- error -> %% macro not found
+ case Ms of
+ #{M:=undefined} ->
+ %% Predefined macro without definition.
throw({error,Lm,{undefined,M,Arity}});
- {ok, undefined} -> %% Predefined macro without definition
- throw({error,Lm,{undefined,M,Arity}});
- {ok, [{none, Def}]} ->
- {ok, Def};
- {ok, Defs} when is_list(Defs) ->
- case proplists:get_value(Arity, Defs) of
+ #{M:=[{none,Def}]} ->
+ {ok,Def};
+ #{M:=Defs} when is_list(Defs) ->
+ case proplists:get_value(Arity, Defs) of
undefined ->
throw({error,Lm,{mismatch,M}});
Def ->
- {ok, Def}
+ {ok,Def}
end;
- {ok, PreDef} -> %% Predefined macro
- {ok, PreDef}
+ #{M:=PreDef} ->
+ %% Predefined macro.
+ {ok,PreDef};
+ _ ->
+ %% Macro not found.
+ throw({error,Lm,{undefined,M,Arity}})
end.
check_uses([], _Anc, _U, _Lm) ->
@@ -1231,7 +1204,7 @@ check_uses([], _Anc, _U, _Lm) ->
check_uses([M|Rest], Anc, U, Lm) ->
case lists:member(M, Anc) of
true ->
- {{_, Name},Arity} = M,
+ {Name,Arity} = M,
throw({error,Lm,{circular,Name,Arity}});
false ->
L = get_macro_uses(M, U),
@@ -1240,25 +1213,41 @@ check_uses([M|Rest], Anc, U, Lm) ->
end.
get_macro_uses({M,Arity}, U) ->
- case dict:find(M, U) of
- error ->
- [];
- {ok, L} ->
- proplists:get_value(Arity, L, proplists:get_value(none, L, []))
+ case U of
+ #{M:=L} ->
+ proplists:get_value(Arity, L, proplists:get_value(none, L, []));
+ _ ->
+ []
end.
%% Macro expansion
%% Note: io:scan_erl_form() does not return comments or white spaces.
-expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], Ms) ->
- expand_macros(atom, MacT, M, Toks, Ms);
+expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], St) ->
+ expand_macros(MacT, M, Toks, St);
%% Special macros
-expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], Ms) ->
+expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_NAME'}=Token|Toks], St0) ->
+ St = update_fun_name(Token, St0),
+ case St#epp.fname of
+ undefined ->
+ [{'?',_Lq},Token];
+ {Name,_} ->
+ [{atom,Lm,Name}]
+ end ++ expand_macros(Toks, St);
+expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_ARITY'}=Token|Toks], St0) ->
+ St = update_fun_name(Token, St0),
+ case St#epp.fname of
+ undefined ->
+ [{'?',_Lq},Token];
+ {_,Arity} ->
+ [{integer,Lm,Arity}]
+ end ++ expand_macros(Toks, St);
+expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], St) ->
Line = erl_scan:line(Tok),
- [{integer,Lm,Line}|expand_macros(Toks, Ms)];
-expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], Ms) ->
- expand_macros(atom, MacT, M, Toks, Ms);
+ [{integer,Lm,Line}|expand_macros(Toks, St)];
+expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], St) ->
+ expand_macros(MacT, M, Toks, St);
%% Illegal macros
-expand_macros([{'?',_Lq},Token|_Toks], _Ms) ->
+expand_macros([{'?',_Lq},Token|_Toks], _St) ->
T = case erl_scan:text(Token) of
Text when is_list(Text) ->
Text;
@@ -1267,9 +1256,9 @@ expand_macros([{'?',_Lq},Token|_Toks], _Ms) ->
io_lib:write(Symbol)
end,
throw({error,loc(Token),{call,[$?|T]}});
-expand_macros([T|Ts], Ms) ->
- [T|expand_macros(Ts, Ms)];
-expand_macros([], _Ms) -> [].
+expand_macros([T|Ts], St) ->
+ [T|expand_macros(Ts, St)];
+expand_macros([], _St) -> [].
%% bind_args(Tokens, MacroLocation, MacroName, ArgumentVars, Bindings)
%% Collect the arguments to a macro call.
@@ -1295,7 +1284,7 @@ macro_args(_Toks, Lm, M, _As, _Bs) ->
store_arg(L, M, _A, [], _Bs) ->
throw({error,L,{mismatch,M}});
store_arg(_L, _M, A, Arg, Bs) ->
- dict:store(A, Arg, Bs).
+ Bs#{A=>Arg}.
%% count_args(Tokens, MacroLine, MacroName)
%% Count the number of arguments in a macro call.
@@ -1368,19 +1357,17 @@ macro_arg([], _E, Arg) ->
%% and then the macro arguments, i.e. simulate textual expansion.
expand_macro([{var,_Lv,V}|Ts], L, Rest, Bs) ->
- case dict:find(V, Bs) of
- {ok,Val} ->
- %% lists:append(Val, expand_macro(Ts, L, Rest, Bs));
+ case Bs of
+ #{V:=Val} ->
expand_arg(Val, Ts, L, Rest, Bs);
- error ->
+ _ ->
[{var,L,V}|expand_macro(Ts, L, Rest, Bs)]
end;
expand_macro([{'?', _}, {'?', _}, {var,_Lv,V}|Ts], L, Rest, Bs) ->
- case dict:find(V, Bs) of
- {ok,Val} ->
- %% lists:append(Val, expand_macro(Ts, L, Rest, Bs));
+ case Bs of
+ #{V:=Val} ->
expand_arg(stringify(Val, L), Ts, L, Rest, Bs);
- error ->
+ _ ->
[{var,L,V}|expand_macro(Ts, L, Rest, Bs)]
end;
expand_macro([T|Ts], L, Rest, Bs) ->
@@ -1394,6 +1381,93 @@ expand_arg([A|As], Ts, _L, Rest, Bs) ->
expand_arg([], Ts, L, Rest, Bs) ->
expand_macro(Ts, L, Rest, Bs).
+%%%
+%%% Here follows support for the ?FUNCTION_NAME and ?FUNCTION_ARITY
+%%% macros. Since the parser has not been run yet, we don't know the
+%%% name and arity of the current function. Therefore, we will need to
+%%% scan the beginning of the current form to extract the name and
+%%% arity of the function.
+%%%
+
+update_fun_name(Token, #epp{fname=Toks0}=St) when is_list(Toks0) ->
+ %% ?FUNCTION_NAME or ?FUNCTION_ARITY is used for the first time in
+ %% a function. First expand macros (except ?FUNCTION_NAME and
+ %% ?FUNCTION_ARITY) in the form.
+
+ Toks1 = (catch expand_macros(Toks0, St#epp{fname=undefined})),
+
+ %% Now extract the name and arity from the stream of tokens, and store
+ %% the result in the #epp{} record so we don't have to do it
+ %% again.
+
+ case Toks1 of
+ [{atom,_,Name},{'(',_}|Toks] ->
+ %% This is the beginning of a function definition.
+ %% Scan the token stream up to the matching right
+ %% parenthesis and count the number of arguments.
+ FA = update_fun_name_1(Toks, 1, {Name,0}, St),
+ St#epp{fname=FA};
+ [{'?',_}|_] ->
+ %% ?FUNCTION_NAME/?FUNCTION_ARITY used at the beginning
+ %% of a form. Does not make sense.
+ {var,_,Macro} = Token,
+ throw({error,loc(Token),{illegal_function_usage,Macro}});
+ _ when is_list(Toks1) ->
+ %% Not the beginning of a function (an attribute or a
+ %% syntax error).
+ {var,_,Macro} = Token,
+ throw({error,loc(Token),{illegal_function,Macro}});
+ _ ->
+ %% A macro expansion error. Return a dummy value and
+ %% let the caller notice and handle the error.
+ St#epp{fname={'_',0}}
+ end;
+update_fun_name(_Token, St) ->
+ St.
+
+update_fun_name_1([Tok|Toks], L, FA, St) ->
+ case classify_token(Tok) of
+ comma ->
+ if
+ L =:= 1 ->
+ {Name,Arity} = FA,
+ update_fun_name_1(Toks, L, {Name,Arity+1}, St);
+ true ->
+ update_fun_name_1(Toks, L, FA, St)
+ end;
+ left ->
+ update_fun_name_1(Toks, L+1, FA, St);
+ right when L =:= 1 ->
+ FA;
+ right ->
+ update_fun_name_1(Toks, L-1, FA, St);
+ other ->
+ case FA of
+ {Name,0} ->
+ update_fun_name_1(Toks, L, {Name,1}, St);
+ {_,_} ->
+ update_fun_name_1(Toks, L, FA, St)
+ end
+ end;
+update_fun_name_1([], _, FA, _) ->
+ %% Syntax error, but never mind.
+ FA.
+
+classify_token({C,_}) -> classify_token_1(C);
+classify_token(_) -> other.
+
+classify_token_1(',') -> comma;
+classify_token_1('(') -> left;
+classify_token_1('{') -> left;
+classify_token_1('[') -> left;
+classify_token_1('<<') -> left;
+classify_token_1(')') -> right;
+classify_token_1('}') -> right;
+classify_token_1(']') -> right;
+classify_token_1('>>') -> right;
+classify_token_1(_) -> other.
+
+
%%% stringify(Ts, L) returns a list of one token: a string which when
%%% tokenized would yield the token list Ts.
diff --git a/lib/stdlib/src/erl_anno.erl b/lib/stdlib/src/erl_anno.erl
index 143318aa55..d32c34dabd 100644
--- a/lib/stdlib/src/erl_anno.erl
+++ b/lib/stdlib/src/erl_anno.erl
@@ -33,7 +33,7 @@
-export_type([anno_term/0]).
--define(LN(L), is_integer(L)).
+-define(LN(L), is_integer(L), L >= 0).
-define(COL(C), (is_integer(C) andalso C >= 1)).
%% Location.
@@ -52,13 +52,13 @@
| {'record', record()}
| {'text', string()}.
--type anno() :: location() | [annotation(), ...].
+-opaque anno() :: location() | [annotation(), ...].
-type anno_term() :: term().
-type column() :: pos_integer().
-type generated() :: boolean().
-type filename() :: file:filename_all().
--type line() :: integer().
+-type line() :: non_neg_integer().
-type location() :: line() | {line(), column()}.
-type record() :: boolean().
-type text() :: string().
@@ -90,9 +90,13 @@ to_term(Anno) ->
-ifdef(DEBUG).
from_term(Term) when is_list(Term) ->
Term;
+from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19
+ set_generated(true, new(-Line));
from_term(Term) ->
[{location, Term}].
-else.
+from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19
+ set_generated(true, new(-Line));
from_term(Term) ->
Term.
-endif.
@@ -198,18 +202,11 @@ file(Anno) ->
Anno :: anno().
generated(Line) when ?ALINE(Line) ->
- Line =< 0;
+ false;
generated({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) ->
- Line =< 0;
+ false;
generated(Anno) ->
- _ = anno_info(Anno, generated, false),
- {location, Location} = lists:keyfind(location, 1, Anno),
- case Location of
- {Line, _Column} ->
- Line =< 0;
- Line ->
- Line =< 0
- end.
+ anno_info(Anno, generated, false).
-spec line(Anno) -> line() when
Anno :: anno().
@@ -226,18 +223,11 @@ line(Anno) ->
Anno :: anno().
location(Line) when ?ALINE(Line) ->
- abs(Line);
-location({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) ->
- {abs(Line), Column};
+ Line;
+location({Line, Column}=Location) when ?ALINE(Line), ?ACOLUMN(Column) ->
+ Location;
location(Anno) ->
- case anno_info(Anno, location) of
- Line when Line < 0 ->
- -Line;
- {Line, Column} when Line < 0 ->
- {-Line, Column};
- Location ->
- Location
- end.
+ anno_info(Anno, location).
-spec record(Anno) -> record() when
Anno :: anno().
@@ -270,31 +260,8 @@ set_file(File, Anno) ->
Generated :: generated(),
Anno :: anno().
-set_generated(true, Line) when ?ALINE(Line) ->
- -abs(Line);
-set_generated(false, Line) when ?ALINE(Line) ->
- abs(Line);
-set_generated(true, {Line, Column}) when ?ALINE(Line),
- ?ACOLUMN(Column) ->
- {-abs(Line),Column};
-set_generated(false, {Line, Column}) when ?ALINE(Line),
- ?ACOLUMN(Column) ->
- {abs(Line),Column};
set_generated(Generated, Anno) ->
- _ = set(generated, Generated, Anno),
- {location, Location} = lists:keyfind(location, 1, Anno),
- NewLocation =
- case Location of
- {Line, Column} when Generated ->
- {-abs(Line), Column};
- {Line, Column} when not Generated ->
- {abs(Line), Column};
- Line when Generated ->
- -abs(Line);
- Line when not Generated ->
- abs(Line)
- end,
- lists:keyreplace(location, 1, Anno, {location, NewLocation}).
+ set(generated, Generated, Anno).
-spec set_line(Line, Anno) -> Anno when
Line :: line(),
@@ -313,38 +280,17 @@ set_line(Line, Anno) ->
Anno :: anno().
set_location(Line, L) when ?ALINE(L), ?LLINE(Line) ->
- new_location(fix_line(Line, L));
+ new_location(Line);
set_location(Line, {L, Column}) when ?ALINE(L), ?ACOLUMN(Column),
?LLINE(Line) ->
- new_location(fix_line(Line, L));
+ new_location(Line);
set_location({L, C}=Loc, Line) when ?ALINE(Line), ?LLINE(L), ?LCOLUMN(C) ->
- new_location(fix_location(Loc, Line));
+ new_location(Loc);
set_location({L, C}=Loc, {Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column),
?LLINE(L), ?LCOLUMN(C) ->
- new_location(fix_location(Loc, Line));
+ new_location(Loc);
set_location(Location, Anno) ->
- _ = set(location, Location, Anno),
- {location, OldLocation} = lists:keyfind(location, 1, Anno),
- NewLocation =
- case {Location, OldLocation} of
- {{_Line, _Column}=Loc, {L, _C}} ->
- fix_location(Loc, L);
- {Line, {L, _C}} ->
- fix_line(Line, L);
- {{_Line, _Column}=Loc, L} ->
- fix_location(Loc, L);
- {Line, L} ->
- fix_line(Line, L)
- end,
- lists:keyreplace(location, 1, Anno, {location, NewLocation}).
-
-fix_location({Line, Column}, OldLine) ->
- {fix_line(Line, OldLine), Column}.
-
-fix_line(Line, OldLine) when OldLine < 0, Line > 0 ->
- -Line;
-fix_line(Line, _OldLine) ->
- Line.
+ set(location, Location, Anno).
-spec set_record(Record, Anno) -> Anno when
Record :: record(),
@@ -383,7 +329,7 @@ set_anno(Item, Value, Anno) ->
_ ->
lists:keyreplace(Item, 1, Anno, {Item, Value})
end,
- simplify(R)
+ reset_simplify(R)
end.
reset(Anno, Item) ->
diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl
index bcfeef7321..9c0a7fb7d5 100644
--- a/lib/stdlib/src/erl_expand_records.erl
+++ b/lib/stdlib/src/erl_expand_records.erl
@@ -33,8 +33,6 @@
vcount=0, % Variable counter
imports=[], % Imports
records=dict:new(), % Record definitions
- trecords=sets:new(), % Typed records
- uses_types=false, % Are there -spec or -type in the module
strict_ra=[], % strict record accesses
checked_ra=[] % successfully accessed records
}).
@@ -47,45 +45,18 @@
%% erl_lint without errors.
module(Fs0, Opts0) ->
Opts = compiler_options(Fs0) ++ Opts0,
- TRecs = typed_records(Fs0),
- UsesTypes = uses_types(Fs0),
- St0 = #exprec{compile = Opts, trecords = TRecs, uses_types = UsesTypes},
+ St0 = #exprec{compile = Opts},
{Fs,_St} = forms(Fs0, St0),
Fs.
compiler_options(Forms) ->
lists:flatten([C || {attribute,_,compile,C} <- Forms]).
-typed_records(Fs) ->
- typed_records(Fs, sets:new()).
-
-typed_records([{attribute,_L,type,{{record, Name},_Defs,[]}} | Fs], Trecs) ->
- typed_records(Fs, sets:add_element(Name, Trecs));
-typed_records([_|Fs], Trecs) ->
- typed_records(Fs, Trecs);
-typed_records([], Trecs) ->
- Trecs.
-
-uses_types([{attribute,_L,spec,_}|_]) -> true;
-uses_types([{attribute,_L,type,_}|_]) -> true;
-uses_types([{attribute,_L,opaque,_}|_]) -> true;
-uses_types([_|Fs]) -> uses_types(Fs);
-uses_types([]) -> false.
-
-forms([{attribute,L,record,{Name,Defs}} | Fs], St0) ->
+forms([{attribute,_,record,{Name,Defs}}=Attr | Fs], St0) ->
NDefs = normalise_fields(Defs),
St = St0#exprec{records=dict:store(Name, NDefs, St0#exprec.records)},
{Fs1, St1} = forms(Fs, St),
- %% Check if we need to keep the record information for usage in types.
- case St#exprec.uses_types of
- true ->
- case sets:is_element(Name, St#exprec.trecords) of
- true -> {Fs1, St1};
- false -> {[{attribute,L,type,{{record,Name},Defs,[]}}|Fs1], St1}
- end;
- false ->
- {Fs1, St1}
- end;
+ {[Attr | Fs1], St1};
forms([{attribute,L,import,Is} | Fs0], St0) ->
St1 = import(Is, St0),
{Fs,St2} = forms(Fs0, St1),
@@ -513,7 +484,6 @@ lc_tq(Line, [F0 | Qs0], St0) ->
lc_tq(_Line, [], St0) ->
{[],St0#exprec{checked_ra = []}}.
-
%% normalise_fields([RecDef]) -> [Field].
%% Normalise the field definitions to always have a default value. If
%% none has been given then use 'undefined'.
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 62b3169a6c..4ca9a609a8 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -31,12 +31,8 @@
-export([is_guard_expr/1]).
-export([bool_option/4,value_option/3,value_option/7]).
--export([modify_line/2]).
-
-import(lists, [member/2,map/2,foldl/3,foldr/3,mapfoldl/3,all/2,reverse/1]).
--deprecated([{modify_line, 2, next_major_release}]).
-
%% bool_option(OnOpt, OffOpt, Default, Options) -> boolean().
%% value_option(Flag, Default, Options) -> Value.
%% value_option(Flag, Default, OnOpt, OnVal, OffOpt, OffVal, Options) ->
@@ -79,7 +75,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
%%-define(DEBUGF(X,Y), io:format(X, Y)).
-define(DEBUGF(X,Y), void).
--type line() :: erl_anno:line(). % a convenient alias
+-type line() :: erl_anno:anno(). % a convenient alias
-type fa() :: {atom(), arity()}. % function+arity
-type ta() :: {atom(), arity()}. % type+arity
@@ -238,6 +234,9 @@ format_error({removed, MFA, ReplacementMFA, Rel}) ->
"use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]);
format_error({removed, MFA, String}) when is_list(String) ->
io_lib:format("~s: ~s", [format_mfa(MFA), String]);
+format_error({removed_type, MNA, ReplacementMNA, Rel}) ->
+ io_lib:format("the type ~s was removed in ~s; use ~s instead",
+ [format_mna(MNA), Rel, format_mna(ReplacementMNA)]);
format_error({obsolete_guard, {F, A}}) ->
io_lib:format("~p/~p obsolete", [F, A]);
format_error({too_many_arguments,Arity}) ->
@@ -361,6 +360,9 @@ format_error({redefine_type, {TypeName, Arity}}) ->
[TypeName, gen_type_paren(Arity)]);
format_error({type_syntax, Constr}) ->
io_lib:format("bad ~w type", [Constr]);
+format_error(old_abstract_code) ->
+ io_lib:format("abstract code generated before Erlang/OTP 19.0 and "
+ "having typed record fields cannot be compiled", []);
format_error({redefine_spec, {M, F, A}}) ->
io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]);
format_error({redefine_spec, {F, A}}) ->
@@ -374,9 +376,9 @@ format_error({spec_fun_undefined, {F, A}}) ->
format_error({missing_spec, {F,A}}) ->
io_lib:format("missing specification for function ~w/~w", [F, A]);
format_error(spec_wrong_arity) ->
- "spec has the wrong arity";
+ "spec has wrong arity";
format_error(callback_wrong_arity) ->
- "callback has the wrong arity";
+ "callback has wrong arity";
format_error({deprecated_builtin_type, {Name, Arity},
Replacement, Rel}) ->
UseS = case Replacement of
@@ -416,6 +418,9 @@ format_mfa({M, F, A}) when is_integer(A) ->
format_mf(M, F, ArityString) when is_atom(M), is_atom(F) ->
atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ ArityString.
+format_mna({M, N, A}) when is_integer(A) ->
+ atom_to_list(M) ++ ":" ++ atom_to_list(N) ++ gen_type_paren(A).
+
format_where(L) when is_integer(L) ->
io_lib:format("(line ~p)", [L]);
format_where({L,C}) when is_integer(L), is_integer(C) ->
@@ -694,7 +699,12 @@ set_form_file({function,L,N,A,C}, File) ->
set_form_file(Form, _File) ->
Form.
+set_file(Ts, File) when is_list(Ts) ->
+ [anno_set_file(T, File) || T <- Ts];
set_file(T, File) ->
+ anno_set_file(T, File).
+
+anno_set_file(T, File) ->
F = fun(Anno) -> erl_anno:set_file(File, Anno) end,
erl_parse:map_anno(F, T).
@@ -1136,7 +1146,7 @@ check_untyped_records(Forms, St0) ->
RecNames = dict:fetch_keys(St0#lint.records),
%% these are the records with field(s) containing type info
TRecNames = [Name ||
- {attribute,_,type,{{record,Name},Fields,_}} <- Forms,
+ {attribute,_,record,{Name,Fields}} <- Forms,
lists:all(fun ({typed_record_field,_,_}) -> true;
(_) -> false
end, Fields)],
@@ -1146,7 +1156,8 @@ check_untyped_records(Forms, St0) ->
[] -> St; % exclude records with no fields
[_|_] -> add_warning(L, {untyped_record, N}, St)
end
- end, St0, RecNames -- TRecNames);
+ end, St0, ordsets:subtract(ordsets:from_list(RecNames),
+ ordsets:from_list(TRecNames)));
false ->
St0
end.
@@ -2436,7 +2447,10 @@ record_def(Line, Name, Fs0, St0) ->
true -> add_error(Line, {redefine_record,Name}, St0);
false ->
{Fs1,St1} = def_fields(normalise_fields(Fs0), Name, St0),
- St1#lint{records=dict:store(Name, {Line,Fs1}, St1#lint.records)}
+ St2 = St1#lint{records=dict:store(Name, {Line,Fs1},
+ St1#lint.records)},
+ Types = [T || {typed_record_field, _, T} <- Fs0],
+ check_type({type, nowarn(), product, Types}, St2)
end.
%% def_fields([RecDef], RecordName, State) -> {[DefField],State}.
@@ -2639,11 +2653,6 @@ find_field(_F, []) -> error.
%% Attr :: 'type' | 'opaque'
%% Checks that a type definition is valid.
-type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) ->
- %% The record field names and such are checked in the record format.
- %% We only need to check the types.
- Types = [T || {typed_record_field, _, T} <- Fields],
- check_type({type, nowarn(), product, Types}, St0);
type_def(Attr, Line, TypeName, ProtoType, Args, St0) ->
TypeDefs = St0#lint.types,
Arity = length(Args),
@@ -2806,6 +2815,8 @@ check_type({user_type, L, TypeName, Args}, SeenVars, St) ->
lists:foldl(fun(T, {AccSeenVars, AccSt}) ->
check_type(T, AccSeenVars, AccSt)
end, {SeenVars, St1}, Args);
+check_type([{typed_record_field,Field,_T}|_], SeenVars, St) ->
+ {SeenVars, add_error(element(2, Field), old_abstract_code, St)};
check_type(I, SeenVars, St) ->
case erl_eval:partial_eval(I) of
{integer,_ILn,_Integer} -> {SeenVars, St};
@@ -2876,7 +2887,7 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) ->
St1 = St0#lint{specs = dict:store(MFA, Line, Specs)},
case dict:is_key(MFA, Specs) of
true -> add_error(Line, {redefine_spec, MFA0}, St1);
- false -> check_specs(TypeSpecs, Arity, St1)
+ false -> check_specs(TypeSpecs, spec_wrong_arity, Arity, St1)
end.
%% callback_decl(Line, Fun, Types, State) -> State.
@@ -2890,7 +2901,8 @@ callback_decl(Line, MFA0, TypeSpecs,
St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)},
case dict:is_key(MFA, Callbacks) of
true -> add_error(Line, {redefine_callback, MFA0}, St1);
- false -> check_specs(TypeSpecs, Arity, St1)
+ false -> check_specs(TypeSpecs, callback_wrong_arity,
+ Arity, St1)
end
end.
@@ -2927,7 +2939,7 @@ is_fa({FuncName, Arity})
when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true;
is_fa(_) -> false.
-check_specs([FunType|Left], Arity, St0) ->
+check_specs([FunType|Left], ETag, Arity, St0) ->
{FunType1, CTypes} =
case FunType of
{type, _, bounded_fun, [FT = {type, _, 'fun', _}, Cs]} ->
@@ -2935,18 +2947,16 @@ check_specs([FunType|Left], Arity, St0) ->
{FT, lists:append(Types0)};
{type, _, 'fun', _} = FT -> {FT, []}
end,
- SpecArity =
- case FunType1 of
- {type, L, 'fun', [any, _]} -> any;
- {type, L, 'fun', [{type, _, product, D}, _]} -> length(D)
- end,
+ {type, L, 'fun', [{type, _, product, D}, _]} = FunType1,
+ SpecArity = length(D),
St1 = case Arity =:= SpecArity of
true -> St0;
- false -> add_error(L, spec_wrong_arity, St0)
+ false -> %% Cannot happen if called from the compiler.
+ add_error(L, ETag, St0)
end,
St2 = check_type({type, nowarn(), product, [FunType1|CTypes]}, St1),
- check_specs(Left, Arity, St2);
-check_specs([], _Arity, St) ->
+ check_specs(Left, ETag, Arity, St2);
+check_specs([], _ETag, _Arity, St) ->
St.
nowarn() ->
@@ -2988,9 +2998,10 @@ add_missing_spec_warnings(Forms, St0, Type) ->
[{FA,L} || {function,L,F,A,_} <- Forms,
not lists:member(FA = {F,A}, Specs)];
exported ->
- Exps = gb_sets:to_list(St0#lint.exports) -- pseudolocals(),
+ Exps0 = gb_sets:to_list(St0#lint.exports) -- pseudolocals(),
+ Exps = Exps0 -- Specs,
[{FA,L} || {function,L,F,A,_} <- Forms,
- member(FA = {F,A}, Exps -- Specs)]
+ member(FA = {F,A}, Exps)]
end,
foldl(fun ({FA,L}, St) ->
add_warning(L, {missing_spec,FA}, St)
@@ -3003,7 +3014,9 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) ->
L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D),
UsedTypes = gb_sets:from_list(L),
FoldFun =
- fun(Type, #typeinfo{line = FileLine}, AccSt) ->
+ fun({{record, _}=_Type, 0}, _, AccSt) ->
+ AccSt; % Before Erlang/OTP 19.0
+ (Type, #typeinfo{line = FileLine}, AccSt) ->
case loc(FileLine, AccSt) of
{FirstFile, _} ->
case gb_sets:is_member(Type, UsedTypes) of
@@ -3190,8 +3203,8 @@ handle_generator(P,E,Vt,Uvt,St0) ->
handle_bitstring_gen_pat({bin,_,Segments=[_|_]},St) ->
case lists:last(Segments) of
{bin_element,Line,{var,_,_},default,Flags} when is_list(Flags) ->
- case member(binary, Flags) orelse member(bits, Flags)
- orelse member(bitstring, Flags) of
+ case member(binary, Flags) orelse member(bytes, Flags)
+ orelse member(bits, Flags) orelse member(bitstring, Flags) of
true ->
add_error(Line, unsized_binary_in_bin_gen_pattern, St);
false ->
@@ -3485,13 +3498,6 @@ vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused].
copy_expr(Expr, Anno) ->
erl_parse:map_anno(fun(_A) -> Anno end, Expr).
-%% modify_line(Form, Fun) -> Form
-%% modify_line(Expression, Fun) -> Expression
-%% Applies Fun to each line number occurrence.
-
-modify_line(T, F0) ->
- erl_parse:map_anno(F0, T).
-
%% Check a record_info call. We have already checked that it is not
%% shadowed by an import.
@@ -3574,6 +3580,8 @@ deprecated_type(L, M, N, As, St) ->
false ->
St
end;
+ {removed, Replacement, Rel} ->
+ add_warning(L, {removed_type, {M,N,NAs}, Replacement, Rel}, St);
no ->
St
end.
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index e82282421e..b1c574ea60 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
+%% 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.
@@ -85,10 +85,6 @@ type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}.
spec_fun -> atom : '$1'.
spec_fun -> atom ':' atom : {'$1', '$3'}.
-%% The following two are retained only for backwards compatibility;
-%% they are not part of the EEP syntax and should be removed.
-spec_fun -> atom '/' integer '::' : {'$1', '$3'}.
-spec_fun -> atom ':' atom '/' integer '::' : {'$1', '$3', '$5'}.
typed_attr_val -> expr ',' typed_record_fields : {typed_record, '$1', '$3'}.
typed_attr_val -> expr '::' top_type : {type_def, '$1', '$3'}.
@@ -525,23 +521,424 @@ Erlang code.
-export([type_inop_prec/1,type_preop_prec/1]).
-export([map_anno/2, fold_anno/3, mapfold_anno/3,
new_anno/1, anno_to_term/1, anno_from_term/1]).
--export([set_line/2,get_attribute/2,get_attributes/1]).
-
--deprecated([{set_line, 2, next_major_release},
- {get_attribute, 2, next_major_release},
- {get_attributes, 1, next_major_release}]).
%% The following directive is needed for (significantly) faster compilation
%% of the generated .erl file by the HiPE compiler. Please do not remove.
-compile([{hipe,[{regalloc,linear_scan}]}]).
-export_type([abstract_clause/0, abstract_expr/0, abstract_form/0,
- error_info/0]).
+ abstract_type/0, error_info/0]).
+
+%% Start of Abstract Format
+
+-type anno() :: erl_anno:anno().
+
+-type abstract_form() :: af_module()
+ | af_behavior()
+ | af_behaviour()
+ | af_export()
+ | af_import()
+ | af_export_type()
+ | af_optional_callbacks()
+ | af_compile()
+ | af_file()
+ | af_record_decl()
+ | af_type_decl()
+ | af_function_spec()
+ | af_wild_attribute()
+ | af_function_decl().
+
+-type af_module() :: {'attribute', anno(), 'module', module()}.
+
+-type af_behavior() :: {'attribute', anno(), 'behavior', behaviour()}.
+
+-type af_behaviour() :: {'attribute', anno(), 'behaviour', behaviour()}.
+
+-type behaviour() :: atom().
+
+-type af_export() :: {'attribute', anno(), 'export', af_fa_list()}.
+
+-type af_import() :: {'attribute', anno(), 'import', af_fa_list()}.
+
+-type af_fa_list() :: [{function_name(), arity()}].
+
+-type af_export_type() :: {'attribute', anno(), 'export_type', af_ta_list()}.
+
+-type af_ta_list() :: [{type_name(), arity()}].
+
+-type af_optional_callbacks() ::
+ {'attribute', anno(), 'optional_callbacks', af_fa_list()}.
+
+-type af_compile() :: {'attribute', anno(), 'compile', any()}.
+
+-type af_file() :: {'attribute', anno(), 'file', {string(), anno()}}.
+
+-type af_record_decl() ::
+ {'attribute', anno(), 'record', {record_name(), [af_field_decl()]}}.
+
+-type af_field_decl() :: af_typed_field() | af_field().
+
+-type af_typed_field() ::
+ {'typed_record_field', af_field(), abstract_type()}.
+
+-type af_field() :: {'record_field', anno(), af_field_name()}
+ | {'record_field', anno(), af_field_name(), abstract_expr()}.
+
+-type af_type_decl() :: {'attribute', anno(), type_attr(),
+ {type_name(), abstract_type(), [af_variable()]}}.
+
+-type type_attr() :: 'opaque' | 'type'.
+
+-type af_function_spec() :: {'attribute', anno(), spec_attr(),
+ {{function_name(), arity()},
+ af_function_type_list()}}
+ | {'attribute', anno(), 'spec',
+ {{module(), function_name(), arity()},
+ af_function_type_list()}}.
+
+-type spec_attr() :: 'callback' | 'spec'.
+
+-type af_wild_attribute() :: {'attribute', anno(), atom(), any()}.
+
+-type af_function_decl() ::
+ {'function', anno(), function_name(), arity(), af_clause_seq()}.
+
+-type abstract_expr() :: af_literal()
+ | af_match(abstract_expr())
+ | af_variable()
+ | af_tuple(abstract_expr())
+ | af_nil()
+ | af_cons(abstract_expr())
+ | af_bin(abstract_expr())
+ | af_binary_op(abstract_expr())
+ | af_unary_op(abstract_expr())
+ | af_record_access(abstract_expr())
+ | af_record_update(abstract_expr())
+ | af_record_index()
+ | af_record_field_access(abstract_expr())
+ | af_map_access(abstract_expr())
+ | af_map_update(abstract_expr())
+ | af_catch()
+ | af_local_call()
+ | af_remote_call()
+ | af_list_comprehension()
+ | af_binary_comprehension()
+ | af_block()
+ | af_if()
+ | af_case()
+ | af_try()
+ | af_receive()
+ | af_local_fun()
+ | af_remote_fun()
+ | af_fun()
+ | af_named_fun().
+
+-type af_record_update(T) :: {'record',
+ anno(),
+ abstract_expr(),
+ record_name(),
+ [af_record_field(T)]}.
+
+-type af_catch() :: {'catch', anno(), abstract_expr()}.
+
+-type af_local_call() :: {'call', anno(), af_local_function(), af_args()}.
+
+-type af_remote_call() :: {'call', anno(), af_remote_function(), af_args()}.
+
+-type af_args() :: [abstract_expr()].
+
+-type af_local_function() :: abstract_expr().
+
+-type af_remote_function() ::
+ {'remote', anno(), abstract_expr(), abstract_expr()}.
+
+-type af_list_comprehension() ::
+ {'lc', anno(), af_template(), af_qualifier_seq()}.
+
+-type af_binary_comprehension() ::
+ {'bc', anno(), af_template(), af_qualifier_seq()}.
+
+-type af_template() :: abstract_expr().
+
+-type af_qualifier_seq() :: [af_qualifier()].
+
+-type af_qualifier() :: af_generator() | af_filter().
+
+-type af_generator() :: {'generate', anno(), af_pattern(), abstract_expr()}
+ | {'b_generate', anno(), af_pattern(), abstract_expr()}.
+
+-type af_filter() :: abstract_expr().
+
+-type af_block() :: {'block', anno(), af_body()}.
+
+-type af_if() :: {'if', anno(), af_clause_seq()}.
+
+-type af_case() :: {'case', anno(), abstract_expr(), af_clause_seq()}.
+
+-type af_try() :: {'try',
+ anno(),
+ af_body() | [],
+ af_clause_seq() | [],
+ af_clause_seq() | [],
+ af_body() | []}.
+
+-type af_clause_seq() :: [af_clause(), ...].
+
+-type af_receive() ::
+ {'receive', anno(), af_clause_seq()}
+ | {'receive', anno(), af_clause_seq(), abstract_expr(), af_body()}.
+
+-type af_local_fun() ::
+ {'fun', anno(), {'function', function_name(), arity()}}.
+
+-type af_remote_fun() ::
+ {'fun', anno(), {'function', module(), function_name(), arity()}}
+ | {'fun', anno(), {'function', af_atom(), af_atom(), af_integer()}}.
+
+-type af_fun() :: {'fun', anno(), {'clauses', af_clause_seq()}}.
+
+-type af_named_fun() :: {'named_fun', anno(), fun_name(), af_clause_seq()}.
+
+-type fun_name() :: atom().
+
+-type abstract_clause() :: af_clause().
+
+-type af_clause() ::
+ {'clause', anno(), [af_pattern()], af_guard_seq(), af_body()}.
+
+-type af_body() :: [abstract_expr(), ...].
+
+-type af_guard_seq() :: [af_guard()].
+
+-type af_guard() :: [af_guard_test(), ...].
+
+-type af_guard_test() :: af_literal()
+ | af_variable()
+ | af_tuple(af_guard_test())
+ | af_nil()
+ | af_cons(af_guard_test())
+ | af_bin(af_guard_test())
+ | af_binary_op(af_guard_test())
+ | af_unary_op(af_guard_test())
+ | af_record_access(af_guard_test())
+ | af_record_index()
+ | af_record_field_access(af_guard_test())
+ | af_map_access(abstract_expr()) % FIXME
+ | af_map_update(abstract_expr()) % FIXME
+ | af_guard_call()
+ | af_remote_guard_call().
+
+-type af_record_field_access(T) ::
+ {'record_field', anno(), T, record_name(), af_field_name()}.
+
+-type af_map_access(T) :: {'map', anno(), [af_map_field(T)]}.
+
+-type af_map_update(T) :: {'map', anno(), T, [af_map_field(T)]}.
+
+-type af_map_field(T) :: af_map_field_assoc(T) | af_map_field_exact(T).
+
+-type af_map_field_assoc(T) :: {'map_field_assoc', anno(), T, T}.
+
+-type af_map_field_exact(T) :: {'map_field_exact', anno(), T, T}.
+
+-type af_guard_call() :: {'call', anno(), function_name(), [af_guard_test()]}.
+
+-type af_remote_guard_call() ::
+ {'call', anno(),
+ {'remote', anno(), af_lit_atom('erlang'), af_atom()},
+ [af_guard_test()]}.
+
+-type af_pattern() :: af_literal()
+ | af_match(af_pattern())
+ | af_variable()
+ | af_tuple(af_pattern())
+ | af_nil()
+ | af_cons(af_pattern())
+ | af_bin(af_pattern())
+ | af_binary_op(af_pattern())
+ | af_unary_op(af_pattern())
+ | af_record_access(af_pattern())
+ | af_record_index()
+ | af_map_pattern().
+
+-type af_record_index() ::
+ {'record_index', anno(), record_name(), af_field_name()}.
+
+-type af_record_access(T) ::
+ {'record', anno(), record_name(), [af_record_field(T)]}.
+
+-type af_record_field(T) :: {'record_field', anno(), af_field_name(), T}.
+
+-type af_map_pattern() ::
+ {'map', anno(), [af_map_field_exact(abstract_expr)]}. % FIXME?
+
+-type abstract_type() :: af_annotated_type()
+ | af_atom()
+ | af_bitstring_type()
+ | af_empty_list_type()
+ | af_fun_type()
+ | af_integer_range_type()
+ | af_map_type()
+ | af_predefined_type()
+ | af_record_type()
+ | af_remote_type()
+ | af_singleton_integer_type()
+ | af_tuple_type()
+ | af_type_union()
+ | af_type_variable()
+ | af_user_defined_type().
+
+-type af_annotated_type() ::
+ {'ann_type', anno(), [af_anno() | abstract_type()]}. % [Var, Type]
+
+-type af_anno() :: af_variable().
+
+-type af_bitstring_type() ::
+ {'type', anno(), 'binary', [af_singleton_integer_type()]}.
+
+-type af_empty_list_type() :: {'type', anno(), 'nil', []}.
+
+-type af_fun_type() :: {'type', anno(), 'fun', []}
+ | {'type', anno(), 'fun', [{'type', anno(), 'any'} |
+ abstract_type()]}
+ | {'type', anno(), 'fun', af_function_type()}.
+
+-type af_integer_range_type() ::
+ {'type', anno(), 'range', [af_singleton_integer_type()]}.
+
+-type af_map_type() :: {'type', anno(), 'map', 'any'}
+ | {'type', anno(), 'map', [af_map_pair_type()]}.
+
+-type af_map_pair_type() ::
+ {'type', anno(), 'map_field_assoc', [abstract_type()]}.
+
+-type af_predefined_type() ::
+ {'type', anno(), type_name(), [abstract_type()]}.
+
+-type af_record_type() ::
+ {'type', anno(), 'record', [(Name :: af_atom()) % [Name, T1, ... Tk]
+ | af_record_field_type()]}.
+
+-type af_record_field_type() ::
+ {'type', anno(), 'field_type', [(Name :: af_atom()) |
+ abstract_type()]}. % [Name, Type]
+
+-type af_remote_type() ::
+ {'remote_type', anno(), [(Module :: af_atom()) |
+ (TypeName :: af_atom()) |
+ [abstract_type()]]}. % [Module, Name, [T]]
+
+-type af_tuple_type() :: {'type', anno(), 'tuple', 'any'}
+ | {'type', anno(), 'tuple', [abstract_type()]}.
+
+-type af_type_union() :: {'type', anno(), 'union', [abstract_type()]}.
+
+-type af_type_variable() :: {'var', anno(), atom()}. % except '_'
+
+-type af_user_defined_type() ::
+ {'user_type', anno(), type_name(), [abstract_type()]}.
+
+-type af_function_type_list() :: [af_constrained_function_type() |
+ af_function_type()].
+
+-type af_constrained_function_type() ::
+ {'type', anno(), 'bounded_fun', [af_function_type() | % [Ft, Fc]
+ af_function_constraint()]}.
+
+-type af_function_type() ::
+ {'type', anno(), 'fun',
+ [{'type', anno(), 'product', [abstract_type()]} | abstract_type()]}.
+
+-type af_function_constraint() :: [af_constraint()].
+
+-type af_constraint() :: {'type', anno(), 'constraint',
+ af_lit_atom('is_subtype'),
+ [af_type_variable() | abstract_type()]}. % [V, T]
+
+-type af_singleton_integer_type() :: af_integer()
+ | af_unary_op(af_singleton_integer_type())
+ | af_binary_op(af_singleton_integer_type()).
+
+-type af_literal() :: af_atom() | af_integer() | af_float() | af_string().
+
+-type af_atom() :: af_lit_atom(atom()).
+
+-type af_lit_atom(A) :: {'atom', anno(), A}.
+
+-type af_integer() :: {'integer', anno(), non_neg_integer()}.
+
+-type af_float() :: {'float', anno(), float()}.
+
+-type af_string() :: {'string', anno(), string()}.
+
+-type af_match(T) :: {'match', anno(), af_pattern(), T}.
+
+-type af_variable() :: {'var', anno(), atom()}. % | af_anon_variable()
+
+%-type af_anon_variable() :: {'var', anno(), '_'}.
+
+-type af_tuple(T) :: {'tuple', anno(), [T]}.
+
+-type af_nil() :: {'nil', anno()}.
+
+-type af_cons(T) :: {'cons', anno(), T, T}.
+
+-type af_bin(T) :: {'bin', anno(), [af_binelement(T)]}.
+
+-type af_binelement(T) :: {'bin_element',
+ anno(),
+ T,
+ af_binelement_size(),
+ type_specifier_list()}.
+
+-type af_binelement_size() :: 'default' | abstract_expr().
+
+-type af_binary_op(T) :: {'op', anno(), binary_op(), T, T}.
+
+-type binary_op() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-'
+ | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++'
+ | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:='
+ | '=/='.
+
+-type af_unary_op(T) :: {'op', anno(), unary_op(), T}.
+
+-type unary_op() :: '+' | '*' | 'bnot' | 'not'.
+
+%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}.
+-type type_specifier_list() :: 'default' | [type_specifier(), ...].
+
+-type type_specifier() :: type()
+ | signedness()
+ | endianness()
+ | unit().
+
+-type type() :: 'integer'
+ | 'float'
+ | 'binary'
+ | 'bytes'
+ | 'bitstring'
+ | 'bits'
+ | 'utf8'
+ | 'utf16'
+ | 'utf32'.
+
+-type signedness() :: 'signed' | 'unsigned'.
+
+-type endianness() :: 'big' | 'little' | 'native'.
+
+-type unit() :: {'unit', 1..256}.
+
+-type record_name() :: atom().
+
+-type af_field_name() :: af_atom().
+
+-type function_name() :: atom().
+
+-type type_name() :: atom().
+
+%% End of Abstract Format
%% XXX. To be refined.
--type abstract_clause() :: term().
--type abstract_expr() :: term().
--type abstract_form() :: term().
-type error_description() :: term().
-type error_info() :: {erl_anno:line(), module(), error_description()}.
-type token() :: erl_scan:token().
@@ -639,14 +1036,8 @@ build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs})
{atom, _, Fun} ->
{Fun, find_arity_from_specs(TypeSpecs)};
{{atom,_, Mod}, {atom,_, Fun}} ->
- {Mod,Fun,find_arity_from_specs(TypeSpecs)};
- {{atom, _, Fun}, {integer, _, Arity}} ->
- %% Old style spec. Allow this for now.
- {Fun,Arity};
- {{atom,_, Mod}, {atom, _, Fun}, {integer, _, Arity}} ->
- %% Old style spec. Allow this for now.
- {Mod,Fun,Arity}
- end,
+ {Mod,Fun,find_arity_from_specs(TypeSpecs)}
+ end,
{attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}.
find_arity_from_specs([Spec|_]) ->
@@ -795,31 +1186,11 @@ record_fields([{match,_Am,{atom,Aa,A},Expr}|Fields]) ->
[{record_field,Aa,{atom,Aa,A},Expr}|record_fields(Fields)];
record_fields([{typed,Expr,TypeInfo}|Fields]) ->
[Field] = record_fields([Expr]),
- TypeInfo1 =
- case Expr of
- {match, _, _, _} -> TypeInfo; %% If we have an initializer.
- {atom, Aa, _} ->
- case has_undefined(TypeInfo) of
- false ->
- lift_unions(abstract2(undefined, Aa), TypeInfo);
- true ->
- TypeInfo
- end
- end,
- [{typed_record_field,Field,TypeInfo1}|record_fields(Fields)];
+ [{typed_record_field,Field,TypeInfo}|record_fields(Fields)];
record_fields([Other|_Fields]) ->
ret_err(?anno(Other), "bad record field");
record_fields([]) -> [].
-has_undefined({atom,_,undefined}) ->
- true;
-has_undefined({ann_type,_,[_,T]}) ->
- has_undefined(T);
-has_undefined({type,_,union,Ts}) ->
- lists:any(fun has_undefined/1, Ts);
-has_undefined(_) ->
- false.
-
term(Expr) ->
try normalise(Expr)
catch _:_R -> ret_err(?anno(Expr), "bad attribute")
@@ -1118,33 +1489,16 @@ type_preop_prec('-') -> {600,700};
type_preop_prec('bnot') -> {600,700};
type_preop_prec('#') -> {700,800}.
-%%% [Experimental]. The parser just copies the attributes of the
-%%% scanner tokens to the abstract format. This design decision has
-%%% been hidden to some extent: use set_line() and get_attribute() to
-%%% access the second element of (almost all) of the abstract format
-%%% tuples. A typical use is to negate line numbers to prevent the
-%%% compiler from emitting warnings and errors. The second element can
-%%% (of course) be set to any value, but then these functions no
-%%% longer apply. To get all present attributes as a property list
-%%% get_attributes() should be used.
-
--compile({nowarn_deprecated_function,{erl_scan,set_attribute,3}}).
-set_line(L, F) ->
- erl_scan:set_attribute(line, L, F).
-
--compile({nowarn_deprecated_function,{erl_scan,attributes_info,2}}).
-get_attribute(L, Name) ->
- erl_scan:attributes_info(L, Name).
-
--compile({nowarn_deprecated_function,{erl_scan,attributes_info,1}}).
-get_attributes(L) ->
- erl_scan:attributes_info(L).
+-type erl_parse_tree() :: abstract_clause()
+ | abstract_expr()
+ | abstract_form()
+ | abstract_type().
-spec map_anno(Fun, Abstr) -> NewAbstr when
Fun :: fun((Anno) -> Anno),
Anno :: erl_anno:anno(),
- Abstr :: abstract_form() | abstract_expr(),
- NewAbstr :: abstract_form() | abstract_expr().
+ Abstr :: erl_parse_tree(),
+ NewAbstr :: erl_parse_tree().
map_anno(F0, Abstr) ->
F = fun(A, Acc) -> {F0(A), Acc} end,
@@ -1157,8 +1511,8 @@ map_anno(F0, Abstr) ->
Acc0 :: term(),
AccIn :: term(),
AccOut :: term(),
- Abstr :: abstract_form() | abstract_expr(),
- NewAbstr :: abstract_form() | abstract_expr().
+ Abstr :: erl_parse_tree(),
+ NewAbstr :: erl_parse_tree().
fold_anno(F0, Acc0, Abstr) ->
F = fun(A, Acc) -> {A, F0(A, Acc)} end,
@@ -1172,26 +1526,26 @@ fold_anno(F0, Acc0, Abstr) ->
Acc1 :: term(),
AccIn :: term(),
AccOut :: term(),
- Abstr :: abstract_form() | abstract_expr(),
- NewAbstr :: abstract_form() | abstract_expr().
+ Abstr :: erl_parse_tree(),
+ NewAbstr :: erl_parse_tree().
mapfold_anno(F, Acc0, Abstr) ->
modify_anno1(Abstr, Acc0, F).
-spec new_anno(Term) -> Abstr when
Term :: term(),
- Abstr :: abstract_form() | abstract_expr().
+ Abstr :: erl_parse_tree().
new_anno(Term) ->
map_anno(fun erl_anno:new/1, Term).
-spec anno_to_term(Abstr) -> term() when
- Abstr :: abstract_form() | abstract_expr().
+ Abstr :: erl_parse_tree().
anno_to_term(Abstract) ->
map_anno(fun erl_anno:to_term/1, Abstract).
--spec anno_from_term(Term) -> abstract_form() | abstract_expr() when
+-spec anno_from_term(Term) -> erl_parse_tree() when
Term :: term().
anno_from_term(Term) ->
diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl
index d2f53816b8..47223b129c 100644
--- a/lib/stdlib/src/erl_scan.erl
+++ b/lib/stdlib/src/erl_scan.erl
@@ -52,25 +52,15 @@
%%% External exports
-export([string/1,string/2,string/3,tokens/3,tokens/4,
- format_error/1,reserved_word/1,
- token_info/1,token_info/2,
- attributes_info/1,attributes_info/2,set_attribute/3]).
+ format_error/1,reserved_word/1]).
-export([column/1,end_location/1,line/1,location/1,text/1,
category/1,symbol/1]).
--deprecated([{attributes_info, 1, next_major_release},
- {attributes_info, 2, next_major_release},
- {set_attribute, 3, next_major_release},
- {token_info, 1, next_major_release},
- {token_info, 2, next_major_release}]).
-
%%% Private
-export([continuation_location/1]).
-export_type([error_info/0,
- line/0,
- location/0,
options/0,
return_cont/0,
token/0,
@@ -85,29 +75,18 @@
-define(ALINE(L), is_integer(L)).
-define(STRING(S), is_list(S)).
-define(RESWORDFUN(F), is_function(F, 1)).
--define(SETATTRFUN(F), is_function(F, 1)).
-type category() :: atom().
--type column() :: pos_integer(). % Deprecated
--type line() :: integer(). % Deprecated
--type location() :: line() | {line(),column()}. % Deprecated
-type resword_fun() :: fun((atom()) -> boolean()).
-type option() :: 'return' | 'return_white_spaces' | 'return_comments'
| 'text' | {'reserved_word_fun', resword_fun()}.
-type options() :: option() | [option()].
-type symbol() :: atom() | float() | integer() | string().
--type info_line() :: integer() | term().
--type attributes_data()
- :: [{'column', column()} | {'line', info_line()} | {'text', string()}]
- | {line(), column()}.
-%% The fact that {line(),column()} is a possible attributes() type
-%% is hidden.
--type attributes() :: line() | attributes_data().
--type token() :: {category(), attributes(), symbol()}
- | {category(), attributes()}.
+-type token() :: {category(), Anno :: erl_anno:anno(), symbol()}
+ | {category(), Anno :: erl_anno:anno()}.
-type tokens() :: [token()].
-type error_description() :: term().
--type error_info() :: {location(), module(), error_description()}.
+-type error_info() :: {erl_anno:location(), module(), error_description()}.
%%% Local record.
-record(erl_scan,
@@ -136,8 +115,8 @@ format_error(Other) ->
String :: string(),
Return :: {'ok', Tokens :: tokens(), EndLocation}
| {'error', ErrorInfo :: error_info(), ErrorLocation},
- EndLocation :: location(),
- ErrorLocation :: location().
+ EndLocation :: erl_anno:location(),
+ ErrorLocation :: erl_anno:location().
string(String) ->
string(String, 1, []).
@@ -145,9 +124,9 @@ string(String) ->
String :: string(),
Return :: {'ok', Tokens :: tokens(), EndLocation}
| {'error', ErrorInfo :: error_info(), ErrorLocation},
- StartLocation :: location(),
- EndLocation :: location(),
- ErrorLocation :: location().
+ StartLocation :: erl_anno:location(),
+ EndLocation :: erl_anno:location(),
+ ErrorLocation :: erl_anno:location().
string(String, StartLocation) ->
string(String, StartLocation, []).
@@ -156,9 +135,9 @@ string(String, StartLocation) ->
Options :: options(),
Return :: {'ok', Tokens :: tokens(), EndLocation}
| {'error', ErrorInfo :: error_info(), ErrorLocation},
- StartLocation :: location(),
- EndLocation :: location(),
- ErrorLocation :: location().
+ StartLocation :: erl_anno:location(),
+ EndLocation :: erl_anno:location(),
+ ErrorLocation :: erl_anno:location().
string(String, Line, Options) when ?STRING(String), ?ALINE(Line) ->
string1(String, options(Options), Line, no_col, []);
string(String, {Line,Column}, Options) when ?STRING(String),
@@ -167,20 +146,23 @@ string(String, {Line,Column}, Options) when ?STRING(String),
string1(String, options(Options), Line, Column, []).
-type char_spec() :: string() | 'eof'.
--type cont_fun() :: fun((char_spec(), #erl_scan{}, line(), column(),
+-type cont_fun() :: fun((char_spec(), #erl_scan{},
+ erl_anno:line(), erl_anno:column(),
tokens(), any()) -> any()).
-opaque return_cont() :: {erl_scan_continuation,
- string(), column(), tokens(), line(),
+ string(), erl_anno:column(), tokens(),
+ erl_anno:line(),
#erl_scan{}, any(), cont_fun()}.
--type tokens_result() :: {'ok', Tokens :: tokens(), EndLocation :: location()}
- | {'eof', EndLocation :: location()}
+-type tokens_result() :: {'ok', Tokens :: tokens(),
+ EndLocation :: erl_anno:location()}
+ | {'eof', EndLocation :: erl_anno:location()}
| {'error', ErrorInfo :: error_info(),
- EndLocation :: location()}.
+ EndLocation :: erl_anno:location()}.
-spec tokens(Continuation, CharSpec, StartLocation) -> Return when
Continuation :: return_cont() | [],
CharSpec :: char_spec(),
- StartLocation :: location(),
+ StartLocation :: erl_anno:location(),
Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()}
| {'more', Continuation1 :: return_cont()}.
tokens(Cont, CharSpec, StartLocation) ->
@@ -189,7 +171,7 @@ tokens(Cont, CharSpec, StartLocation) ->
-spec tokens(Continuation, CharSpec, StartLocation, Options) -> Return when
Continuation :: return_cont() | [],
CharSpec :: char_spec(),
- StartLocation :: location(),
+ StartLocation :: erl_anno:location(),
Options :: options(),
Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()}
| {'more', Continuation1 :: return_cont()}.
@@ -257,155 +239,6 @@ symbol({_Category,_Anno,Symbol}) ->
symbol(T) ->
erlang:error(badarg, [T]).
--type attribute_item() :: 'column' | 'length' | 'line'
- | 'location' | 'text'.
--type info_location() :: location() | term().
--type attribute_info() :: {'column', column()}| {'length', pos_integer()}
- | {'line', info_line()}
- | {'location', info_location()}
- | {'text', string()}.
--type token_item() :: 'category' | 'symbol' | attribute_item().
--type token_info() :: {'category', category()} | {'symbol', symbol()}
- | attribute_info().
-
--spec token_info(Token) -> TokenInfo when
- Token :: token(),
- TokenInfo :: [TokenInfoTuple :: token_info()].
-token_info(Token) ->
- Items = [category,column,length,line,symbol,text], % undefined order
- token_info(Token, Items).
-
--spec token_info(Token, TokenItem) -> TokenInfoTuple | 'undefined' when
- Token :: token(),
- TokenItem :: token_item(),
- TokenInfoTuple :: token_info();
- (Token, TokenItems) -> TokenInfo when
- Token :: token(),
- TokenItems :: [TokenItem :: token_item()],
- TokenInfo :: [TokenInfoTuple :: token_info()].
-token_info(_Token, []) ->
- [];
-token_info(Token, [Item|Items]) when is_atom(Item) ->
- case token_info(Token, Item) of
- undefined ->
- token_info(Token, Items);
- TokenInfo when is_tuple(TokenInfo) ->
- [TokenInfo|token_info(Token, Items)]
- end;
-token_info({Category,_Attrs}, category=Item) ->
- {Item,Category};
-token_info({Category,_Attrs,_Symbol}, category=Item) ->
- {Item,Category};
-token_info({Category,_Attrs}, symbol=Item) ->
- {Item,Category};
-token_info({_Category,_Attrs,Symbol}, symbol=Item) ->
- {Item,Symbol};
-token_info({_Category,Attrs}, Item) ->
- attributes_info(Attrs, Item);
-token_info({_Category,Attrs,_Symbol}, Item) ->
- attributes_info(Attrs, Item).
-
--spec attributes_info(Attributes) -> AttributesInfo when
- Attributes :: attributes(),
- AttributesInfo :: [AttributeInfoTuple :: attribute_info()].
-attributes_info(Attributes) ->
- Items = [column,length,line,text], % undefined order
- attributes_info(Attributes, Items).
-
--spec attributes_info
- (Attributes, AttributeItem) -> AttributeInfoTuple | 'undefined' when
- Attributes :: attributes(),
- AttributeItem :: attribute_item(),
- AttributeInfoTuple :: attribute_info();
- (Attributes, AttributeItems) -> AttributeInfo when
- Attributes :: attributes(),
- AttributeItems :: [AttributeItem :: attribute_item()],
- AttributeInfo :: [AttributeInfoTuple :: attribute_info()].
-attributes_info(_Attrs, []) ->
- [];
-attributes_info(Attrs, [A|As]) when is_atom(A) ->
- case attributes_info(Attrs, A) of
- undefined ->
- attributes_info(Attrs, As);
- AttributeInfo when is_tuple(AttributeInfo) ->
- [AttributeInfo|attributes_info(Attrs, As)]
- end;
-attributes_info({Line,Column}, column=Item) when ?ALINE(Line),
- ?COLUMN(Column) ->
- {Item,Column};
-attributes_info(Line, column) when ?ALINE(Line) ->
- undefined;
-attributes_info(Attrs, column=Item) ->
- case attr_info(Attrs, Item) of
- undefined ->
- case erl_anno:column(Attrs) of
- undefined ->
- undefined;
- Column ->
- {Item,Column}
- end;
- T ->
- T
- end;
-attributes_info(Attrs, length=Item) ->
- case attributes_info(Attrs, text) of
- undefined ->
- undefined;
- {text,Text} ->
- {Item,length(Text)}
- end;
-attributes_info(Line, line=Item) when ?ALINE(Line) ->
- {Item,Line};
-attributes_info({Line,Column}, line=Item) when ?ALINE(Line),
- ?COLUMN(Column) ->
- {Item,Line};
-attributes_info(Attrs, line=Item) ->
- case attr_info(Attrs, Item) of
- undefined ->
- case attr_info(Attrs, location) of
- {location,{Line,_Column}} ->
- {Item,Line};
- {location,Line} ->
- {Item,Line};
- undefined ->
- undefined
- end;
- T ->
- T
- end;
-attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line),
- ?COLUMN(Column) ->
- {Item,Location};
-attributes_info(Line, location=Item) when ?ALINE(Line) ->
- {Item,Line};
-attributes_info(Attrs, location=Item) ->
- {line,Line} = attributes_info(Attrs, line),
- case attributes_info(Attrs, column) of
- undefined ->
- %% If set_attribute() has assigned a term such as {17,42}
- %% to 'line', then Line will look like {Line,Column}. One
- %% should not use 'location' but 'line' and 'column' in
- %% such special cases.
- {Item,Line};
- {column,Column} ->
- {Item,{Line,Column}}
- end;
-attributes_info({Line,Column}, text) when ?ALINE(Line), ?COLUMN(Column) ->
- undefined;
-attributes_info(Line, text) when ?ALINE(Line) ->
- undefined;
-attributes_info(Attrs, text=Item) ->
- attr_info(Attrs, Item);
-attributes_info(T1, T2) ->
- erlang:error(badarg, [T1,T2]).
-
--spec set_attribute(AttributeItem, Attributes, SetAttributeFun) -> Attributes when
- AttributeItem :: 'line',
- Attributes :: attributes(),
- SetAttributeFun :: fun((info_line()) -> info_line()).
-set_attribute(Tag, Attributes, Fun) when ?SETATTRFUN(Fun) ->
- set_attr(Tag, Attributes, Fun).
-
%%%
%%% Local functions
%%%
@@ -471,62 +304,6 @@ expand_opt(return, Os) ->
expand_opt(O, Os) ->
[O|Os].
-attr_info(Attrs, Item) ->
- try lists:keyfind(Item, 1, Attrs) of
- {_Item, _Value} = T ->
- T;
- false ->
- undefined
- catch
- _:_ ->
- erlang:error(badarg, [Attrs, Item])
- end.
-
--spec set_attr('line', attributes(), fun((line()) -> line())) -> attributes().
-
-set_attr(line, Line, Fun) when ?ALINE(Line) ->
- Ln = Fun(Line),
- if
- ?ALINE(Ln) ->
- Ln;
- true ->
- [{line,Ln}]
- end;
-set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) ->
- Ln = Fun(Line),
- if
- ?ALINE(Ln) ->
- {Ln,Column};
- true ->
- [{line,Ln},{column,Column}]
- end;
-set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) ->
- case lists:keyfind(Tag, 1, Attrs) of
- {line,Line} ->
- case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of
- [{line,Ln}] when ?ALINE(Ln) ->
- Ln;
- As ->
- As
- end;
- false ->
- {location, Location} = lists:keyfind(location, 1, Attrs),
- Ln = case Location of
- {Line,Column} when ?ALINE(Line), ?COLUMN(Column) ->
- {Fun(Line),Column};
- _ ->
- Fun(Location)
- end,
- case lists:keyreplace(location, 1, Attrs, {location,Ln}) of
- [{location,Ln}] when ?ALINE(Ln) ->
- Ln;
- As ->
- As
- end
- end;
-set_attr(T1, T2, T3) ->
- erlang:error(badarg, [T1,T2,T3]).
-
tokens1(Cs, St, Line, Col, Toks, Fun, Any) when ?STRING(Cs); Cs =:= eof ->
case Fun(Cs, St, Line, Col, Toks, Any) of
{more,{Cs0,Ncol,Ntoks,Nline,Nany,Nfun}} ->
diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl
index 41b49f4a86..b8ce311c35 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -38,7 +38,7 @@
-record(state, {file :: file:filename(),
module :: module(),
forms_or_bin,
- source :: source(),
+ source :: source() | 'undefined',
n_errors :: non_neg_integer(),
mode :: mode(),
exports_main :: boolean(),
@@ -49,9 +49,9 @@
-type emu_args() :: string().
-record(sections, {type,
- shebang :: shebang(),
- comment :: comment(),
- emu_args :: emu_args(),
+ shebang :: shebang() | 'undefined',
+ comment :: comment() | 'undefined',
+ emu_args :: emu_args() | 'undefined',
body}).
-record(extract_options, {compile_source}).
diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl
index 0d50392b96..3aeaff8dc4 100644
--- a/lib/stdlib/src/file_sorter.erl
+++ b/lib/stdlib/src/file_sorter.erl
@@ -307,7 +307,6 @@ options(Option) ->
options([{format, Format} | L], Opts) when Format =:= binary;
Format =:= term;
- is_function(Format),
is_function(Format, 1) ->
options(L, Opts#opts{format = Format});
options([{format, binary_term} | L], Opts) ->
@@ -326,7 +325,7 @@ options([{tmpdir, Dir} | L], Opts) ->
FileName ->
options(L, Opts#opts{tmpdir = {dir, FileName}})
end;
-options([{order, Fun} | L], Opts) when is_function(Fun), is_function(Fun, 2) ->
+options([{order, Fun} | L], Opts) when is_function(Fun, 2) ->
options(L, Opts#opts{order = Fun});
options([{order, Order} | L], Opts) when Order =:= ascending;
Order =:= descending ->
@@ -411,7 +410,7 @@ merge_terms_fun(RFun) ->
case RFun(read) of
end_of_input ->
eof;
- {Objs, NRFun} when is_function(NRFun), is_function(NRFun, 1) ->
+ {Objs, NRFun} when is_function(NRFun, 1) ->
{_, [], Ts, _} = fun_objs(Objs, [], 0, ?MAXSIZE, I, W),
{{I, Ts, ?CHUNKSIZE}, merge_terms_fun(NRFun)};
Error ->
@@ -427,13 +426,12 @@ merge_bins_fun(FileName) ->
Fun(A)
end.
-wrap_output_terms(term, OutFun, _Z) when is_function(OutFun),
- is_function(OutFun, 1) ->
+wrap_output_terms(term, OutFun, _Z) when is_function(OutFun, 1) ->
{fun_wterms(OutFun), true};
wrap_output_terms(term, File, Z) when File =/= undefined ->
{file_wterms(name, File, Z++[write]), false};
wrap_output_terms(_Format, Output, _Z) ->
- {Output, is_function(Output) and is_function(Output, 1)}.
+ {Output, is_function(Output, 1)}.
binary_term_fun() ->
fun binary_to_term/1.
@@ -1311,8 +1309,7 @@ infun(W) ->
{end_of_input, W1};
{end_of_input, Value} ->
{end_of_input, W1#w{inout_value = {value, Value}}};
- {Objs, NFun} when is_function(NFun),
- is_function(NFun, 1),
+ {Objs, NFun} when is_function(NFun, 1),
is_list(Objs) ->
{cont, W#w{in = NFun}, Objs};
Error ->
@@ -1335,7 +1332,7 @@ outfun(A, W) ->
try (W#w.out)(A) of
Reply when A =:= close ->
Reply;
- NF when is_function(NF), is_function(NF, 1) ->
+ NF when is_function(NF, 1) ->
W#w{out = NF};
Error ->
error(Error, W1)
@@ -1360,7 +1357,7 @@ is_keyposs([Bad | _]) ->
is_keyposs(Bad) ->
{badarg, Bad}.
-is_input(Fun) when is_function(Fun), is_function(Fun, 1) ->
+is_input(Fun) when is_function(Fun, 1) ->
{true, Fun};
is_input(Files) ->
is_files(Files).
@@ -1380,7 +1377,7 @@ is_files([], L) ->
is_files(Bad, _L) ->
{badarg, Bad}.
-maybe_output(Fun) when is_function(Fun), is_function(Fun, 1) ->
+maybe_output(Fun) when is_function(Fun, 1) ->
{true, Fun};
maybe_output(File) ->
case read_file_info(File) of
@@ -1589,7 +1586,6 @@ fun_rterms(InFun) ->
(read) ->
case InFun(read) of
{Ts, NInFun} when is_list(Ts),
- is_function(NInFun),
is_function(NInFun, 1) ->
{to_bin(Ts, []), fun_rterms(NInFun)};
Else ->
@@ -1602,7 +1598,7 @@ fun_wterms(OutFun) ->
OutFun(close);
(L) ->
case OutFun(wterms_arg(L)) of
- NOutFun when is_function(NOutFun), is_function(NOutFun, 1) ->
+ NOutFun when is_function(NOutFun, 1) ->
fun_wterms(NOutFun);
Else ->
Else
diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl
index 284f2e5a2b..f510f61e9f 100644
--- a/lib/stdlib/src/io.erl
+++ b/lib/stdlib/src/io.erl
@@ -444,7 +444,7 @@ scan_erl_form(Io, Prompt, Pos0, Options) ->
%% Parsing Erlang code.
-type parse_ret() :: {'ok',
- ExprList :: erl_parse:abstract_expr(),
+ ExprList :: [erl_parse:abstract_expr()],
EndLocation :: location()}
| {'eof', EndLocation :: location()}
| {'error',
@@ -631,41 +631,20 @@ io_requests(Pid, [], [Rs|Cont], Tail) ->
io_requests(_Pid, [], [], _Tail) ->
{false,[]}.
-
-bc_req(Pid,{Op,Enc,Param},MaybeConvert) ->
- case net_kernel:dflag_unicode_io(Pid) of
- true ->
- {false,{Op,Enc,Param}};
- false ->
- {MaybeConvert,{Op,Param}}
- end;
-bc_req(Pid,{Op,Enc,P,F},MaybeConvert) ->
- case net_kernel:dflag_unicode_io(Pid) of
- true ->
- {false,{Op,Enc,P,F}};
- false ->
- {MaybeConvert,{Op,P,F}}
- end;
-bc_req(Pid, {Op,Enc,M,F,A},MaybeConvert) ->
+bc_req(Pid, Req0, MaybeConvert) ->
case net_kernel:dflag_unicode_io(Pid) of
true ->
- {false,{Op,Enc,M,F,A}};
+ %% The most common case. A modern i/o server.
+ {false,Req0};
false ->
- {MaybeConvert,{Op,M,F,A}}
- end;
-bc_req(Pid, {Op,Enc,P,M,F,A},MaybeConvert) ->
- case net_kernel:dflag_unicode_io(Pid) of
- true ->
- {false,{Op,Enc,P,M,F,A}};
- false ->
- {MaybeConvert,{Op,P,M,F,A}}
- end;
-bc_req(Pid,{Op,Enc},MaybeConvert) ->
- case net_kernel:dflag_unicode_io(Pid) of
- true ->
- {false,{Op, Enc}};
- false ->
- {MaybeConvert,Op}
+ %% Backward compatibility only. Unlikely to ever happen.
+ case tuple_to_list(Req0) of
+ [Op,_Enc] ->
+ {MaybeConvert,Op};
+ [Op,_Enc|T] ->
+ Req = list_to_tuple([Op|T]),
+ {MaybeConvert,Req}
+ end
end.
io_request(Pid, {write,Term}) ->
diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl
index b67b6f75d7..24b5fde1db 100644
--- a/lib/stdlib/src/ms_transform.erl
+++ b/lib/stdlib/src/ms_transform.erl
@@ -307,15 +307,18 @@ cleanup_filename({Old,OldRec,OldWarnings}) ->
add_record_definition({Name,FieldList}) ->
{KeyList,_} = lists:foldl(
- fun({record_field,_,{atom,Line0,FieldName}},{L,C}) ->
- {[{FieldName,C,{atom,Line0,undefined}}|L],C+1};
- ({record_field,_,{atom,_,FieldName},Def},{L,C}) ->
- {[{FieldName,C,Def}|L],C+1}
- end,
+ fun(F, {L,C}) -> {[record_field(F, C)|L],C+1} end,
{[],2},
FieldList),
put_records([{Name,KeyList}|get_records()]).
+record_field({record_field,_,{atom,Line0,FieldName}}, C) ->
+ {FieldName,C,{atom,Line0,undefined}};
+record_field({record_field,_,{atom,_,FieldName},Def}, C) ->
+ {FieldName,C,Def};
+record_field({typed_record_field,Field,_Type}, C) ->
+ record_field(Field, C).
+
forms([F0|Fs0]) ->
F1 = form(F0),
Fs1 = forms(Fs0),
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 9d394e19d7..6f546da7b8 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -588,49 +588,40 @@ obsolete_1(asn1rt, utf8_list_to_binary, 1) ->
%% Added in OTP 18.
obsolete_1(core_lib, get_anno, 1) ->
- {deprecated,{cerl,get_ann,1}};
+ {removed,{cerl,get_ann,1},"19"};
obsolete_1(core_lib, set_anno, 2) ->
- {deprecated,{cerl,set_ann,2}};
+ {removed,{cerl,set_ann,2},"19"};
obsolete_1(core_lib, is_literal, 1) ->
- {deprecated,{cerl,is_literal,1}};
+ {removed,{cerl,is_literal,1},"19"};
obsolete_1(core_lib, is_literal_list, 1) ->
- {deprecated,"deprecated; use lists:all(fun cerl:is_literal/1, L)"
+ {removed,"removed; use lists:all(fun cerl:is_literal/1, L)"
" instead"};
obsolete_1(core_lib, literal_value, 1) ->
- {deprecated,{core_lib,concrete,1}};
+ {removed,{core_lib,concrete,1},"19"};
obsolete_1(erl_scan, set_attribute, 3) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"};
+ {removed,{erl_anno,set_line,2},"19.0"};
obsolete_1(erl_scan, attributes_info, 1) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use "
+ {removed,"removed in 19.0; use "
"erl_anno:{column,line,location,text}/1 instead"};
obsolete_1(erl_scan, attributes_info, 2) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use "
+ {removed,"removed in 19.0; use "
"erl_anno:{column,line,location,text}/1 instead"};
obsolete_1(erl_scan, token_info, 1) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use "
+ {removed,"removed in 19.0; use "
"erl_scan:{category,column,line,location,symbol,text}/1 instead"};
obsolete_1(erl_scan, token_info, 2) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use "
+ {removed,"removed in 19.0; use "
"erl_scan:{category,column,line,location,symbol,text}/1 instead"};
obsolete_1(erl_parse, set_line, 2) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"};
+ {removed,{erl_anno,set_line,2},"19.0"};
obsolete_1(erl_parse, get_attributes, 1) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use "
+ {removed,"removed in 19.0; use "
"erl_anno:{column,line,location,text}/1 instead"};
obsolete_1(erl_parse, get_attribute, 2) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use "
+ {removed,"removed in 19.0; use "
"erl_anno:{column,line,location,text}/1 instead"};
obsolete_1(erl_lint, modify_line, 2) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use erl_parse:map_anno/2 instead"};
+ {removed,{erl_parse,map_anno,2},"19.0"};
obsolete_1(ssl, negotiated_next_protocol, 1) ->
{deprecated,{ssl,negotiated_protocol,1}};
@@ -650,8 +641,16 @@ obsolete_1(httpd_conf, is_file, 1) ->
obsolete_1(httpd_conf, make_integer, 1) ->
{deprecated, "deprecated; use erlang:list_to_integer/1 instead"};
+%% Added in OTP 19.
+
+obsolete_1(random, _, _) ->
+ {deprecated, "the 'random' module is deprecated; "
+ "use the 'rand' module instead"};
+obsolete_1(code, rehash, 0) ->
+ {deprecated, "deprecated because the code path cache feature has been removed"};
+
obsolete_1(overload, _, _) ->
- {deprecated, "deprecated; will be removed in OTP 19"};
+ {removed, "removed in OTP 19"};
obsolete_1(_, _, _) ->
no.
@@ -705,6 +704,7 @@ is_snmp_agent_function(_, _) -> false.
-spec obsolete_type(module(), atom(), arity()) ->
'no' | {tag(), string()} | {tag(), mfas(), release()}.
+-dialyzer({no_match, obsolete_type/3}).
obsolete_type(Module, Name, NumberOfVariables) ->
case obsolete_type_1(Module, Name, NumberOfVariables) of
{deprecated=Tag,{_,_,_}=Replacement} ->
@@ -718,13 +718,10 @@ obsolete_type(Module, Name, NumberOfVariables) ->
end.
obsolete_type_1(erl_scan,column,0) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use erl_anno:column() instead"};
+ {removed,{erl_anno,column,0},"19.0"};
obsolete_type_1(erl_scan,line,0) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use erl_anno:line() instead"};
+ {removed,{erl_anno,line,0},"19.0"};
obsolete_type_1(erl_scan,location,0) ->
- {deprecated,
- "deprecated (will be removed in OTP 19); use erl_anno:location() instead"};
+ {removed,{erl_anno,location,0},"19.0"};
obsolete_type_1(_,_,_) ->
no.
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index 1ae7c6cc25..b396ba7057 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -810,21 +810,21 @@ options(Options0, [Key | Keys], L) when is_list(Options0) ->
{ok, U};
{pre_fun, U=undefined} ->
{ok, U};
- {info_fun, Fun} when is_function(Fun), is_function(Fun, 1) ->
+ {info_fun, Fun} when is_function(Fun, 1) ->
{ok, Fun};
- {pre_fun, Fun} when is_function(Fun), is_function(Fun, 1) ->
+ {pre_fun, Fun} when is_function(Fun, 1) ->
{ok, Fun};
- {post_fun, Fun} when is_function(Fun), is_function(Fun, 0) ->
+ {post_fun, Fun} when is_function(Fun, 0) ->
{ok, Fun};
- {lookup_fun, Fun} when is_function(Fun), is_function(Fun, 2) ->
+ {lookup_fun, Fun} when is_function(Fun, 2) ->
{ok, Fun};
{max_lookup, Max} when is_integer(Max), Max >= 0 ->
{ok, Max};
{max_lookup, infinity} ->
{ok, -1};
- {format_fun, Fun} when is_function(Fun), is_function(Fun, 1) ->
+ {format_fun, Fun} when is_function(Fun, 1) ->
{ok, Fun};
- {parent_fun, Fun} when is_function(Fun), is_function(Fun, 0) ->
+ {parent_fun, Fun} when is_function(Fun, 0) ->
{ok, Fun};
{key_equality, KE='=='} ->
{ok, KE};
@@ -887,7 +887,7 @@ options(Options0, [Key | Keys], L) when is_list(Options0) ->
{depth, Depth} when Depth =:= infinity;
is_integer(Depth), Depth >= 0 ->
{ok, Depth};
- {order, Order} when is_function(Order), is_function(Order, 2);
+ {order, Order} when is_function(Order, 2);
(Order =:= ascending);
(Order =:= descending) ->
{ok, Order};
diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl
index 9577d17a85..e4b9768b12 100644
--- a/lib/stdlib/src/qlc_pt.erl
+++ b/lib/stdlib/src/qlc_pt.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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.
@@ -200,7 +200,7 @@ exclude_integers_from_unique_line_numbers(Forms, NodeInfo) ->
find_integers(Forms) ->
F = fun(A) ->
- Fs1 = erl_parse:map_anno(fun(_) -> A end, Forms),
+ Fs1 = map_anno(fun(_) -> A end, Forms),
ordsets:from_list(integers(Fs1, []))
end,
ordsets:to_list(ordsets:intersection(F(anno0()), F(anno1()))).
@@ -319,13 +319,13 @@ badarg(Forms, State) ->
E0.
lc_nodes(E, NodeInfo) ->
- erl_parse:map_anno(fun(Anno) ->
- N = erl_anno:line(Anno),
- [{N, Data}] = ets:lookup(NodeInfo, N),
- NData = Data#{inside_lc => true},
- true = ets:insert(NodeInfo, {N, NData}),
- Anno
- end, E).
+ map_anno(fun(Anno) ->
+ N = erl_anno:line(Anno),
+ [{N, Data}] = ets:lookup(NodeInfo, N),
+ NData = Data#{inside_lc => true},
+ true = ets:insert(NodeInfo, {N, NData}),
+ Anno
+ end, E).
used_genvar_messages(MsL, S) ->
[{File,[{Loc,?APIMOD,{used_generator_variable,V}}]}
@@ -416,7 +416,7 @@ intro_anno(LC, Where, QId, NodeInfo) ->
true = ets:insert(NodeInfo, {Location,Data}),
Anno
end,
- erl_parse:map_anno(Fun, save_anno(LC, NodeInfo)).
+ map_anno(Fun, save_anno(LC, NodeInfo)).
compile_errors(FormsNoShadows) ->
case compile_forms(FormsNoShadows, []) of
@@ -1650,7 +1650,7 @@ reset_anno(T) ->
set_anno(T, anno0()).
set_anno(T, A) ->
- erl_parse:map_anno(fun(_L) -> A end, T).
+ map_anno(fun(_L) -> A end, T).
-record(fstate, {state, bind_fun, imported}).
@@ -1914,9 +1914,9 @@ expand_pattern_records(P, State) ->
expand_expr_records(E, State) ->
RecordDefs = State#state.records,
A = anno1(),
- Forms = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}],
- [{function,_,foo,0,[{clause,_,[],[],[NE]}]}] =
- erl_expand_records:module(Forms, [no_strict_record_tests]),
+ Forms0 = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}],
+ Forms = erl_expand_records:module(Forms0, [no_strict_record_tests]),
+ {function,_,foo,0,[{clause,_,[],[],[NE]}]} = lists:last(Forms),
NE.
%% Partial evaluation.
@@ -2609,7 +2609,7 @@ save_anno(Abstr, NodeInfo) ->
true = ets:insert(NodeInfo, Data),
erl_anno:new(N)
end,
- erl_parse:map_anno(F, Abstr).
+ map_anno(F, Abstr).
next_slot(T) ->
I = ets:update_counter(T, var_n, 1),
@@ -2633,7 +2633,7 @@ restore_anno(Abstr, NodeInfo) ->
Anno
end
end,
- erl_parse:map_anno(F, Abstr).
+ map_anno(F, Abstr).
restore_loc(Location, #state{node_info = NodeInfo}) ->
case ets:lookup(NodeInfo, Location) of
@@ -2872,6 +2872,14 @@ var_mapfold(F, A0, [E0 | Es0]) ->
var_mapfold(_F, A, E) ->
{E, A}.
+map_anno(F, AbstrList) when is_list(AbstrList) ->
+ [map_anno1(F, Abstr) || Abstr <- AbstrList];
+map_anno(F, Abstr) ->
+ map_anno1(F, Abstr).
+
+map_anno1(F, Abstr) ->
+ erl_parse:map_anno(F, Abstr).
+
family_list(L) ->
sofs:to_external(family(L)).
diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl
index 8b67cde56c..8b639dd0a7 100644
--- a/lib/stdlib/src/random.erl
+++ b/lib/stdlib/src/random.erl
@@ -18,6 +18,7 @@
%% %CopyrightEnd%
%%
-module(random).
+-deprecated(module).
%% Reasonable random number generator.
%% The method is attributed to B. A. Wichmann and I. D. Hill
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index ce1d9eb0ff..82a3a2be4f 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -917,9 +917,9 @@ expand_records(UsedRecords, E0) ->
RecordDefs = [Def || {_Name,Def} <- UsedRecords],
L = erl_anno:new(1),
E = prep_rec(E0),
- Forms = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}],
- [{function,L,foo,0,[{clause,L,[],[],[NE]}]}] =
- erl_expand_records:module(Forms, [strict_record_tests]),
+ Forms0 = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}],
+ Forms = erl_expand_records:module(Forms0, [strict_record_tests]),
+ {function,L,foo,0,[{clause,L,[],[],[NE]}]} = lists:last(Forms),
prep_rec(NE).
prep_rec({value,_CommandN,_V}=Value) ->
@@ -1081,6 +1081,8 @@ record_fields([{record_field,_,{atom,_,Field}} | Fs]) ->
[Field | record_fields(Fs)];
record_fields([{record_field,_,{atom,_,Field},_} | Fs]) ->
[Field | record_fields(Fs)];
+record_fields([{typed_record_field,Field,_Type} | Fs]) ->
+ record_fields([Field | Fs]);
record_fields([]) ->
[].
diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl
index 24fc8ce204..4e629a5e56 100644
--- a/lib/stdlib/src/slave.erl
+++ b/lib/stdlib/src/slave.erl
@@ -289,10 +289,7 @@ register_unique_name(Number) ->
%% no need to use rsh.
mk_cmd(Host, Name, Args, Waiter, Prog0) ->
- Prog = case os:type() of
- {ose,_} -> mk_ose_prog(Prog0);
- _ -> quote_progname(Prog0)
- end,
+ Prog = quote_progname(Prog0),
BasicCmd = lists:concat([Prog,
" -detached -noinput -master ", node(),
" ", long_or_short(), Name, "@", Host,
@@ -312,24 +309,6 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
end
end.
-%% On OSE we have to pass the beam arguments directory to the slave
-%% process. To find out what arguments that should be passed on we
-%% make an assumption. All arguments after the last "--" should be
-%% skipped. So given these arguments:
-%% -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' -- -name test@localhost
-%% we send
-%% -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' --
-%% to the slave with whatever other args that are added in mk_cmd.
-mk_ose_prog(Prog) ->
- SkipTail = fun("--",[]) ->
- ["--"];
- (_,[]) ->
- [];
- (Arg,Args) ->
- [Arg," "|Args]
- end,
- [Prog,tl(lists:foldr(SkipTail,[],erlang:system_info(emu_args)))].
-
%% This is an attempt to distinguish between spaces in the program
%% path and spaces that separate arguments. The program is quoted to
%% allow spaces in the path.
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index cecdebd0c8..0400c845ab 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -110,11 +110,13 @@
-define(SET, sets:set).
-record(state, {name,
- strategy :: strategy(),
+ strategy :: strategy() | 'undefined',
children = [] :: [child_rec()],
- dynamics :: ?DICT(pid(), list()) | ?SET(pid()),
- intensity :: non_neg_integer(),
- period :: pos_integer(),
+ dynamics :: {'dict', ?DICT(pid(), list())}
+ | {'set', ?SET(pid())}
+ | 'undefined',
+ intensity :: non_neg_integer() | 'undefined',
+ period :: pos_integer() | 'undefined',
restarts = [],
dynamic_restarts = 0 :: non_neg_integer(),
module,
@@ -579,7 +581,7 @@ handle_cast({try_again_restart,Pid}, #state{children=[Child]}=State)
when ?is_simple(State) ->
RT = Child#child.restart_type,
RPid = restarting(Pid),
- case dynamic_child_args(RPid, dynamics_db(RT, State#state.dynamics)) of
+ case dynamic_child_args(RPid, RT, State#state.dynamics) of
{ok, Args} ->
{M, F, _} = Child#child.mfargs,
NChild = Child#child{pid = RPid, mfargs = {M, F, Args}},
@@ -737,7 +739,7 @@ handle_start_child(Child, State) ->
restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) ->
RestartType = Child#child.restart_type,
- case dynamic_child_args(Pid, dynamics_db(RestartType, State#state.dynamics)) of
+ case dynamic_child_args(Pid, RestartType, State#state.dynamics) of
{ok, Args} ->
{M, F, _} = Child#child.mfargs,
NChild = Child#child{pid = Pid, mfargs = {M, F, Args}},
@@ -821,16 +823,18 @@ restart(simple_one_for_one, Child, State0) ->
State#state.dynamics)),
case do_start_child_i(M, F, A) of
{ok, Pid} ->
- NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)},
+ DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)},
+ NState = State#state{dynamics = DynamicsDb},
{ok, NState};
{ok, Pid, _Extra} ->
- NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)},
+ DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)},
+ NState = State#state{dynamics = DynamicsDb},
{ok, NState};
{error, Error} ->
NRestarts = State#state.dynamic_restarts + 1,
+ DynamicsDb = {dict, ?DICTS:store(restarting(OldPid), A, Dynamics)},
NState = State#state{dynamic_restarts = NRestarts,
- dynamics = ?DICTS:store(restarting(OldPid), A,
- Dynamics)},
+ dynamics = DynamicsDb},
report_error(start_error, Error, Child, State#state.name),
{try_again, NState}
end;
@@ -1113,31 +1117,32 @@ save_child(Child, #state{children = Children} = State) ->
State#state{children = [Child |Children]}.
save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) ->
- State#state{dynamics = ?SETS:add_element(Pid, dynamics_db(temporary, Dynamics))};
+ DynamicsDb = dynamics_db(temporary, Dynamics),
+ State#state{dynamics = {set, ?SETS:add_element(Pid, DynamicsDb)}};
save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) ->
- State#state{dynamics = ?DICTS:store(Pid, Args, dynamics_db(RestartType, Dynamics))}.
+ DynamicsDb = dynamics_db(RestartType, Dynamics),
+ State#state{dynamics = {dict, ?DICTS:store(Pid, Args, DynamicsDb)}}.
dynamics_db(temporary, undefined) ->
?SETS:new();
dynamics_db(_, undefined) ->
?DICTS:new();
-dynamics_db(_,Dynamics) ->
- Dynamics.
-
-dynamic_child_args(Pid, Dynamics) ->
- case ?SETS:is_set(Dynamics) of
- true ->
- {ok, undefined};
- false ->
- ?DICTS:find(Pid, Dynamics)
- end.
+dynamics_db(_, {_Tag, DynamicsDb}) ->
+ DynamicsDb.
+
+dynamic_child_args(_Pid, temporary, _DynamicsDb) ->
+ {ok, undefined};
+dynamic_child_args(Pid, _RT, {dict, DynamicsDb}) ->
+ ?DICTS:find(Pid, DynamicsDb);
+dynamic_child_args(_Pid, _RT, undefined) ->
+ error.
state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) ->
NDynamics = ?SETS:del_element(Pid, dynamics_db(temporary, State#state.dynamics)),
- State#state{dynamics = NDynamics};
+ State#state{dynamics = {set, NDynamics}};
state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) ->
NDynamics = ?DICTS:erase(Pid, dynamics_db(RType, State#state.dynamics)),
- State#state{dynamics = NDynamics};
+ State#state{dynamics = {dict, NDynamics}};
state_del_child(Child, State) ->
NChildren = del_child(Child#child.name, State#state.children),
State#state{children = NChildren}.
@@ -1171,19 +1176,19 @@ split_child(_, [], After) ->
get_child(Name, State) ->
get_child(Name, State, false).
+
get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) ->
get_dynamic_child(Pid, State);
get_child(Name, State, _) ->
lists:keysearch(Name, #child.name, State#state.children).
get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) ->
- DynamicsDb = dynamics_db(Child#child.restart_type, Dynamics),
- case is_dynamic_pid(Pid, DynamicsDb) of
+ case is_dynamic_pid(Pid, Dynamics) of
true ->
{value, Child#child{pid=Pid}};
false ->
RPid = restarting(Pid),
- case is_dynamic_pid(RPid, DynamicsDb) of
+ case is_dynamic_pid(RPid, Dynamics) of
true ->
{value, Child#child{pid=RPid}};
false ->
@@ -1194,13 +1199,12 @@ get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) ->
end
end.
-is_dynamic_pid(Pid, Dynamics) ->
- case ?SETS:is_set(Dynamics) of
- true ->
- ?SETS:is_element(Pid, Dynamics);
- false ->
- ?DICTS:is_key(Pid, Dynamics)
- end.
+is_dynamic_pid(Pid, {dict, Dynamics}) ->
+ ?DICTS:is_key(Pid, Dynamics);
+is_dynamic_pid(Pid, {set, Dynamics}) ->
+ ?SETS:is_element(Pid, Dynamics);
+is_dynamic_pid(_Pid, undefined) ->
+ false.
replace_child(Child, State) ->
Chs = do_replace_child(Child, State#state.children),
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index e366c2b755..287f63b2be 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -107,8 +107,7 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \
- -I$(ERL_TOP)/lib/kernel/include \
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/include \
-I$(ERL_TOP)/lib/stdlib/include
EBIN = .
diff --git a/lib/stdlib/test/array_SUITE.erl b/lib/stdlib/test/array_SUITE.erl
index ab4ca91f76..6fec03a2f7 100644
--- a/lib/stdlib/test/array_SUITE.erl
+++ b/lib/stdlib/test/array_SUITE.erl
@@ -20,7 +20,7 @@
-module(array_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Default timetrap timeout (set in init_per_testcase).
%% This should be set relatively high (10-15 times the expected
diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl
index 75eebba6c6..f750145ef0 100644
--- a/lib/stdlib/test/base64_SUITE.erl
+++ b/lib/stdlib/test/base64_SUITE.erl
@@ -340,7 +340,7 @@ interleaved_ws_roundtrip_1([], Base64List, Bin, List) ->
random_byte_list(0, Acc) ->
Acc;
random_byte_list(N, Acc) ->
- random_byte_list(N-1, [random:uniform(255)|Acc]).
+ random_byte_list(N-1, [rand:uniform(255)|Acc]).
make_big_binary(N) ->
list_to_binary(mbb(N, [])).
diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl
index c102f6e929..5de7b661e5 100644
--- a/lib/stdlib/test/beam_lib_SUITE.erl
+++ b/lib/stdlib/test/beam_lib_SUITE.erl
@@ -28,7 +28,7 @@
-define(t,test_server).
-define(privdir, "beam_lib_SUITE_priv").
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), ok).
-define(privdir, ?config(priv_dir, Conf)).
-endif.
diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl
index 70c946bdb9..8bb29b6a26 100644
--- a/lib/stdlib/test/binary_module_SUITE.erl
+++ b/lib/stdlib/test/binary_module_SUITE.erl
@@ -37,7 +37,7 @@
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init_per_testcase/2, end_per_testcase/2]).
% Default timetrap timeout (set in init_per_testcase).
% Some of these testcases are really heavy...
@@ -536,6 +536,12 @@ do_interesting(Module) ->
?line [<<3>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>,
[<<1>>,<<2>>,<<4>>,<<5>>,<<7>>,<<8>>],
[global,trim_all]),
+ [<<>>] = binary:split(<<>>, <<",">>, []),
+ [] = binary:split(<<>>, <<",">>, [trim]),
+ [] = binary:split(<<>>, <<",">>, [trim_all]),
+ [] = binary:split(<<>>, <<",">>, [global,trim]),
+ [] = binary:split(<<>>, <<",">>, [global,trim_all]),
+
?line badarg = ?MASK_ERROR(
Module:replace(<<1,2,3,4,5,6,7,8>>,
[<<4,5>>,<<7>>,<<8>>],<<99>>,
@@ -710,7 +716,7 @@ do_interesting(Module) ->
encode_decode(doc) ->
["test binary:encode_unsigned/1,2 and binary:decode_unsigned/1,2"];
encode_decode(Config) when is_list(Config) ->
- ?line random:seed({1271,769940,559934}),
+ rand:seed(exsplus, {1271,769940,559934}),
?line ok = encode_decode_loop({1,200},1000), % Need to be long enough
% to create offheap binaries
ok.
@@ -817,7 +823,7 @@ copy(Config) when is_list(Config) ->
?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3>>,
16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)),
?line <<>> = binary:copy(<<>>,10000),
- ?line random:seed({1271,769940,559934}),
+ rand:seed(exsplus, {1271,769940,559934}),
?line ok = random_copy(3000),
?line erts_debug:set_internal_state(available_internal_state,true),
?line io:format("oldlimit: ~p~n",
@@ -855,7 +861,7 @@ random_copy(0) ->
ok;
random_copy(N) ->
Str = random_string({0,N}),
- Num = random:uniform(N div 10+1),
+ Num = rand:uniform(N div 10+1),
A = ?MASK_ERROR(binary:copy(Str,Num)),
B = ?MASK_ERROR(binref:copy(Str,Num)),
C = ?MASK_ERROR(binary:copy(make_unaligned(Str),Num)),
@@ -896,7 +902,7 @@ bin_to_list(Config) when is_list(Config) ->
?line [5] = lists:nthtail(byte_size(X)-1,LX),
?line [0,5] = lists:nthtail(byte_size(X)-2,LX),
?line [0,5] = lists:nthtail(byte_size(Y)-2,LY),
- ?line random:seed({1271,769940,559934}),
+ rand:seed(exsplus, {1271,769940,559934}),
?line ok = random_bin_to_list(5000),
ok.
@@ -963,7 +969,7 @@ parts(Config) when is_list(Config) ->
?line badarg = ?MASK_ERROR(binary:part(Simple,{-1,0})),
?line badarg = ?MASK_ERROR(binary:part(Simple,{7,2})),
?line <<8>> = binary:part(Simple,{7,1}),
- ?line random:seed({1271,769940,559934}),
+ rand:seed(exsplus, {1271,769940,559934}),
?line random_parts(5000),
ok.
@@ -987,15 +993,15 @@ random_parts(N) ->
random_parts(0,_) ->
[];
random_parts(X,N) ->
- Pos = random:uniform(N),
- Len = random:uniform((Pos * 12) div 10),
+ Pos = rand:uniform(N),
+ Len = rand:uniform((Pos * 12) div 10),
[{Pos,Len} | random_parts(X-1,N)].
random_ref_comp(doc) ->
["Test pseudorandomly generated cases against reference imlementation"];
random_ref_comp(Config) when is_list(Config) ->
put(success_counter,0),
- random:seed({1271,769940,559934}),
+ rand:seed(exsplus, {1271,769940,559934}),
Nr = {1,40},
Hr = {30,1000},
I1 = 1500,
@@ -1025,7 +1031,7 @@ random_ref_sr_comp(doc) ->
["Test pseudorandomly generated cases against reference imlementation of split and replace"];
random_ref_sr_comp(Config) when is_list(Config) ->
put(success_counter,0),
- random:seed({1271,769940,559934}),
+ rand:seed(exsplus, {1271,769940,559934}),
Nr = {1,40},
Hr = {30,1000},
I1 = 1500,
@@ -1043,7 +1049,7 @@ random_ref_fla_comp(doc) ->
["Test pseudorandomly generated cases against reference imlementation of split and replace"];
random_ref_fla_comp(Config) when is_list(Config) ->
?line put(success_counter,0),
- ?line random:seed({1271,769940,559934}),
+ rand:seed(exsplus, {1271,769940,559934}),
?line do_random_first_comp(5000,{1,1000}),
?line do_random_last_comp(5000,{1,1000}),
?line do_random_at_comp(5000,{1,1000}),
@@ -1377,24 +1383,24 @@ one_random(N) ->
random_number({Min,Max}) -> % Min and Max are *length* of number in
% decimal positions
- X = random:uniform(Max - Min + 1) + Min - 1,
- list_to_integer([one_random_number(random:uniform(10)) || _ <- lists:seq(1,X)]).
+ X = rand:uniform(Max - Min + 1) + Min - 1,
+ list_to_integer([one_random_number(rand:uniform(10)) || _ <- lists:seq(1,X)]).
random_length({Min,Max}) ->
- random:uniform(Max - Min + 1) + Min - 1.
+ rand:uniform(Max - Min + 1) + Min - 1.
random_string({Min,Max}) ->
- X = random:uniform(Max - Min + 1) + Min - 1,
- list_to_binary([one_random(random:uniform(68)) || _ <- lists:seq(1,X)]).
+ X = rand:uniform(Max - Min + 1) + Min - 1,
+ list_to_binary([one_random(rand:uniform(68)) || _ <- lists:seq(1,X)]).
random_substring({Min,Max},Hay) ->
- X = random:uniform(Max - Min + 1) + Min - 1,
+ X = rand:uniform(Max - Min + 1) + Min - 1,
Y = byte_size(Hay),
Z = if
X > Y -> Y;
true -> X
end,
PMax = Y - Z,
- Pos = random:uniform(PMax + 1) - 1,
+ Pos = rand:uniform(PMax + 1) - 1,
<<_:Pos/binary,Res:Z/binary,_/binary>> = Hay,
Res.
diff --git a/lib/stdlib/test/c_SUITE.erl b/lib/stdlib/test/c_SUITE.erl
index f3a713abfd..47dd95f86b 100644
--- a/lib/stdlib/test/c_SUITE.erl
+++ b/lib/stdlib/test/c_SUITE.erl
@@ -23,7 +23,7 @@
-export([c_1/1, c_2/1, c_3/1, c_4/1, nc_1/1, nc_2/1, nc_3/1, nc_4/1,
ls/1, memory/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-import(c, [c/2, nc/2]).
diff --git a/lib/stdlib/test/calendar_SUITE.erl b/lib/stdlib/test/calendar_SUITE.erl
index 498b1f459c..bddc3a4821 100644
--- a/lib/stdlib/test/calendar_SUITE.erl
+++ b/lib/stdlib/test/calendar_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(calendar_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,
diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl
index 35e587afcc..ee3a812e24 100644
--- a/lib/stdlib/test/dets_SUITE.erl
+++ b/lib/stdlib/test/dets_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
+%% 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.
@@ -28,7 +28,7 @@
-define(privdir(_), "./dets_SUITE_priv").
-define(datadir(_), "./dets_SUITE_data").
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), ok).
-define(privdir(Conf), ?config(priv_dir, Conf)).
-define(datadir(Conf), ?config(data_dir, Conf)).
@@ -53,7 +53,8 @@
simultaneous_open/1, insert_new/1, repair_continuation/1,
otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1,
otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1,
- otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1]).
+ otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1,
+ otp_13260/1]).
-export([dets_dirty_loop/0]).
@@ -110,7 +111,8 @@ all() ->
many_clients, otp_4906, otp_5402, simultaneous_open,
insert_new, repair_continuation, otp_5487, otp_6206,
otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898,
- otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709
+ otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709,
+ otp_13229, otp_13260
].
groups() ->
@@ -4012,6 +4014,66 @@ otp_11709(Config) when is_list(Config) ->
_ = file:delete(File),
ok.
+otp_13229(doc) ->
+ ["OTP-13229. open_file() exits with badarg when given binary file name."];
+otp_13229(_Config) ->
+ F = <<"binfile.tab">>,
+ try dets:open_file(name, [{file, F}]) of
+ R ->
+ exit({open_succeeded, R})
+ catch
+ error:badarg ->
+ ok
+ end.
+
+otp_13260(doc) ->
+ ["OTP-13260. Race when opening a table."];
+otp_13260(Config) ->
+ [ok] = lists:usort([otp_13260_1(Config) || _ <- lists:seq(1, 3)]),
+ ok.
+
+otp_13260_1(Config) ->
+ Tab = otp_13260,
+ File = filename(Tab, Config),
+ N = 20,
+ P = self(),
+ Pids = [spawn_link(fun() -> counter(P, Tab, File) end) ||
+ _ <- lists:seq(1, N)],
+ Rs = rec(Pids),
+ true = lists:all(fun(R) -> is_integer(R) end, Rs),
+ wait_for_close(Tab).
+
+rec([]) ->
+ [];
+rec([Pid | Pids]) ->
+ receive {Pid, R} ->
+ [R | rec(Pids)]
+ end.
+
+%% One may have to run the test several times to trigger the bug.
+counter(P, Tab, File) ->
+ Key = key,
+ N = case catch dets:update_counter(Tab, Key, 1) of
+ {'EXIT', _} ->
+ {ok, Tab} = dets:open_file(Tab, [{file, File}]),
+ ok = dets:insert(Tab, {Key, 1}),
+ dets:update_counter(Tab, Key, 1);
+ N1 when is_integer(N1) ->
+ N1;
+ DetsBug ->
+ DetsBug
+ end,
+ P ! {self(), N}.
+
+wait_for_close(Tab) ->
+ case dets:info(Tab, owner) of
+ undefined ->
+ ok;
+ _ ->
+ timer:sleep(100),
+ wait_for_close(Tab)
+ end.
+
%%
%% Parts common to several test cases
%%
diff --git a/lib/stdlib/test/dict_SUITE.erl b/lib/stdlib/test/dict_SUITE.erl
index 648154ebbe..92d31bb748 100644
--- a/lib/stdlib/test/dict_SUITE.erl
+++ b/lib/stdlib/test/dict_SUITE.erl
@@ -28,7 +28,7 @@
init_per_testcase/2,end_per_testcase/2,
create/1,store/1,iterate/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-import(lists, [foldl/3]).
@@ -108,7 +108,7 @@ iterate_1(M) ->
M(empty, []).
iterate_2(M) ->
- random:seed(1, 2, 42),
+ rand:seed(exsplus, {1,2,42}),
iter_tree(M, 1000).
iter_tree(_M, 0) ->
@@ -117,7 +117,7 @@ iter_tree(M, N) ->
L = [{I, I} || I <- lists:seq(1, N)],
T = M(from_list, L),
L = lists:reverse(iterate_tree(M, T)),
- R = random:uniform(N),
+ R = rand:uniform(N),
KV = lists:reverse(iterate_tree_from(M, R, T)),
KV = [P || P={K,_} <- L, K >= R],
iter_tree(M, N-1).
@@ -156,7 +156,7 @@ test_all(Tester) ->
spawn_tester(M, Tester) ->
Parent = self(),
spawn_link(fun() ->
- random:seed(1, 2, 42),
+ rand:seed(exsplus, {1,2,42}),
S = Tester(M),
Res = {M(size, S),lists:sort(M(to_list, S))},
Parent ! {result,self(),Res}
@@ -194,12 +194,12 @@ rnd_list_1(0, Acc) ->
Acc;
rnd_list_1(N, Acc) ->
Key = atomic_rnd_term(),
- Value = random:uniform(100),
+ Value = rand:uniform(100),
rnd_list_1(N-1, [{Key,Value}|Acc]).
atomic_rnd_term() ->
- case random:uniform(3) of
- 1 -> list_to_atom(integer_to_list($\s+random:uniform(94))++"rnd");
- 2 -> random:uniform();
- 3 -> random:uniform(50)-37
+ case rand:uniform(3) of
+ 1 -> list_to_atom(integer_to_list($\s+rand:uniform(94))++"rnd");
+ 2 -> rand:uniform();
+ 3 -> rand:uniform(50)-37
end.
diff --git a/lib/stdlib/test/digraph_SUITE.erl b/lib/stdlib/test/digraph_SUITE.erl
index 9e007fe17d..97561196d8 100644
--- a/lib/stdlib/test/digraph_SUITE.erl
+++ b/lib/stdlib/test/digraph_SUITE.erl
@@ -24,7 +24,7 @@
-ifdef(STANDALONE).
-define(line, put(line, ?LINE), ).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-endif.
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/stdlib/test/digraph_utils_SUITE.erl b/lib/stdlib/test/digraph_utils_SUITE.erl
index 747ccf322c..e155857bd4 100644
--- a/lib/stdlib/test/digraph_utils_SUITE.erl
+++ b/lib/stdlib/test/digraph_utils_SUITE.erl
@@ -23,7 +23,7 @@
-ifdef(debug).
-define(line, put(line, ?LINE), ).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-endif.
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl
index 6fdc4c35df..b0a07a95a3 100644
--- a/lib/stdlib/test/edlin_expand_SUITE.erl
+++ b/lib/stdlib/test/edlin_expand_SUITE.erl
@@ -25,7 +25,7 @@
-export([init_per_testcase/2, end_per_testcase/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl
index 4e5df661b3..0c00e104b7 100644
--- a/lib/stdlib/test/epp_SUITE.erl
+++ b/lib/stdlib/test/epp_SUITE.erl
@@ -25,9 +25,9 @@
upcase_mac_1/1, upcase_mac_2/1,
variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1,
pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1,
- otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8503/1,
+ otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1,
otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1,
- otp_11728/1, encoding/1]).
+ otp_11728/1, encoding/1, extends/1, function_macro/1]).
-export([epp_parse_erl_form/2]).
@@ -47,7 +47,7 @@ config(priv_dir, _) ->
config(data_dir, _) ->
filename:absname("./epp_SUITE_data").
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init_per_testcase/2, end_per_testcase/2]).
% Default timetrap timeout (set in init_per_testcase).
@@ -68,9 +68,9 @@ all() ->
[rec_1, {group, upcase_mac}, include_local, predef_mac,
{group, variable}, otp_4870, otp_4871, otp_5362, pmod,
not_circular, skip_header, otp_6277, otp_7702, otp_8130,
- overload_mac, otp_8388, otp_8470, otp_8503, otp_8562,
+ overload_mac, otp_8388, otp_8470, otp_8562,
otp_8665, otp_8911, otp_10302, otp_10820, otp_11728,
- encoding].
+ encoding, extends, function_macro].
groups() ->
[{upcase_mac, [], [upcase_mac_1, upcase_mac_2]},
@@ -621,6 +621,10 @@ otp_8130(Config) when is_list(Config) ->
" 2 end,\n"
" 7),\n"
" {2,7} =\n"
+ " ?M1(begin 1 = fun _Name () -> 1 end(),\n"
+ " 2 end,\n"
+ " 7),\n"
+ " {2,7} =\n"
" ?M1(begin 1 = fun t0/0(),\n"
" 2 end,\n"
" 7),\n"
@@ -645,6 +649,9 @@ otp_8130(Config) when is_list(Config) ->
" ?M1(begin yes = try 1 of 1 -> yes after foo end,\n"
" 2 end,\n"
" 7),\n"
+ " {[42],7} =\n"
+ " ?M1([42],\n"
+ " 7),\n"
"ok.\n">>,
ok},
@@ -728,11 +735,16 @@ otp_8130(Config) when is_list(Config) ->
{errors,[{{2,2},epp,{include,lib,"$apa/foo.hrl"}}],[]}},
- {otp_8130_c9,
+ {otp_8130_c9a,
<<"-define(S, ?S).\n"
"t() -> ?S.\n">>,
{errors,[{{2,9},epp,{circular,'S', none}}],[]}},
+ {otp_8130_c9b,
+ <<"-define(S(), ?S()).\n"
+ "t() -> ?S().\n">>,
+ {errors,[{{2,9},epp,{circular,'S', 0}}],[]}},
+
{otp_8130_c10,
<<"\n-file.">>,
{errors,[{{2,2},epp,{bad,file}}],[]}},
@@ -799,6 +811,10 @@ otp_8130(Config) when is_list(Config) ->
<<"\n-include(\"no such file.erl\").\n">>,
{errors,[{{2,2},epp,{include,file,"no such file.erl"}}],[]}},
+ {otp_8130_c25,
+ <<"\n-define(A.\n">>,
+ {errors,[{{2,2},epp,{bad,define}}],[]}},
+
{otp_8130_7,
<<"-record(b, {b}).\n"
"-define(A, {{a,#b.b.\n"
@@ -826,14 +842,15 @@ otp_8130(Config) when is_list(Config) ->
"-define(a, 3.14).\n"
"t() -> ?a.\n"),
?line {ok,Epp} = epp:open(File, []),
- ?line ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE','LINE',
- 'MACHINE','MODULE','MODULE_STRING'] = macs(Epp),
+ PreDefMacs = macs(Epp),
+ ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE',
+ 'FUNCTION_ARITY','FUNCTION_NAME',
+ 'LINE','MACHINE','MODULE','MODULE_STRING'] = PreDefMacs,
?line {ok,[{'-',_},{atom,_,file}|_]} = epp:scan_erl_form(Epp),
?line {ok,[{'-',_},{atom,_,module}|_]} = epp:scan_erl_form(Epp),
?line {ok,[{atom,_,t}|_]} = epp:scan_erl_form(Epp),
?line {eof,_} = epp:scan_erl_form(Epp),
- ?line ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE','LINE',
- 'MACHINE','MODULE','MODULE_STRING',a] = macs(Epp),
+ [a] = macs(Epp) -- PreDefMacs,
?line epp:close(Epp),
%% escript
@@ -1214,23 +1231,8 @@ otp_8470(Config) when is_list(Config) ->
?line receive _ -> fail() after 0 -> ok end,
ok.
-otp_8503(doc) ->
- ["OTP-8503. Record with no fields is considered typed."];
-otp_8503(suite) ->
- [];
-otp_8503(Config) when is_list(Config) ->
- Dir = ?config(priv_dir, Config),
- C = <<"-record(r, {}).">>,
- ?line File = filename:join(Dir, "otp_8503.erl"),
- ?line ok = file:write_file(File, C),
- ?line {ok, List} = epp:parse_file(File, [], []),
- ?line [_] = [F || {attribute,_,type,{{record,r},[],[]}}=F <- List],
- file:delete(File),
- ?line receive _ -> fail() after 0 -> ok end,
- ok.
-
otp_8562(doc) ->
- ["OTP-8503. Record with no fields is considered typed."];
+ ["OTP-8562. Record with no fields is considered typed."];
otp_8562(suite) ->
[];
otp_8562(Config) when is_list(Config) ->
@@ -1476,6 +1478,102 @@ encoding(Config) when is_list(Config) ->
epp_parse_file(ErlFile, [{default_encoding,utf8},extra]),
ok.
+extends(Config) ->
+ Cs = [{extends_c1,
+ <<"-extends(some.other.module).\n">>,
+ {errors,[{1,erl_parse,["syntax error before: ","'.'"]}],[]}}],
+ [] = compile(Config, Cs),
+
+ Ts = [{extends_1,
+ <<"-extends(some_other_module).\n"
+ "t() -> {?BASE_MODULE,?BASE_MODULE_STRING}.\n">>,
+ {some_other_module,"some_other_module"}}],
+
+ [] = run(Config, Ts),
+ ok.
+
+function_macro(Config) ->
+ Cs = [{f_c1,
+ <<"-define(FUNCTION_NAME, a).\n"
+ "-define(FUNCTION_ARITY, a).\n"
+ "-define(FS,\n"
+ " atom_to_list(?FUNCTION_NAME) ++ \"/\" ++\n"
+ " integer_to_list(?FUNCTION_ARITY)).\n"
+ "-attr({f,?FUNCTION_NAME}).\n"
+ "-attr2(?FS).\n"
+ "-file(?FUNCTION_ARITY, 1).\n"
+ "f1() ?FUNCTION_NAME/?FUNCTION_ARITY.\n"
+ "f2(?FUNCTION_NAME.\n">>,
+ {errors,[{1,epp,{redefine_predef,'FUNCTION_NAME'}},
+ {2,epp,{redefine_predef,'FUNCTION_ARITY'}},
+ {6,epp,{illegal_function,'FUNCTION_NAME'}},
+ {7,epp,{illegal_function,'FUNCTION_NAME'}},
+ {8,epp,{illegal_function,'FUNCTION_ARITY'}},
+ {9,erl_parse,["syntax error before: ","f1"]},
+ {10,erl_parse,["syntax error before: ","'.'"]}],
+ []}},
+
+ {f_c2,
+ <<"a({a) -> ?FUNCTION_NAME.\n"
+ "b(}{) -> ?FUNCTION_ARITY.\n"
+ "c(?FUNCTION_NAME, ?not_defined) -> ok.\n">>,
+ {errors,[{1,erl_parse,["syntax error before: ","')'"]},
+ {2,erl_parse,["syntax error before: ","'}'"]},
+ {3,epp,{undefined,not_defined,none}}],
+ []}},
+
+ {f_c3,
+ <<"?FUNCTION_NAME() -> ok.\n"
+ "?FUNCTION_ARITY() -> ok.\n">>,
+ {errors,[{1,epp,{illegal_function_usage,'FUNCTION_NAME'}},
+ {2,epp,{illegal_function_usage,'FUNCTION_ARITY'}}],
+ []}}
+ ],
+
+ [] = compile(Config, Cs),
+
+ Ts = [{f_1,
+ <<"t() -> {a,0} = a(), {b,1} = b(1), {c,2} = c(1, 2),\n"
+ " {d,1} = d({d,1}), {foo,1} = foo(foo), ok.\n"
+ "a() -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n"
+ "b(_) -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n"
+ "c(_, (_)) -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n"
+ "d({?FUNCTION_NAME,?FUNCTION_ARITY}=F) -> F.\n"
+ "-define(FOO, foo).\n"
+ "?FOO(?FOO) -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n">>,
+ ok},
+
+ {f_2,
+ <<"t() ->\n"
+ " A = {a,[<<0:24>>,#{a=>1,b=>2}]},\n"
+ " 1 = a(A),\n"
+ " ok.\n"
+ "a({a,[<<_,_,_>>,#{a:=1,b:=2}]}) -> ?FUNCTION_ARITY.\n">>,
+ ok},
+
+ {f_3,
+ <<"-define(FS,\n"
+ " atom_to_list(?FUNCTION_NAME) ++ \"/\" ++\n"
+ " integer_to_list(?FUNCTION_ARITY)).\n"
+ "t() ->\n"
+ " {t,0} = {?FUNCTION_NAME,?FUNCTION_ARITY},\n"
+ " \"t/0\" = ?FS,\n"
+ " ok.\n">>,
+ ok},
+
+ {f_4,
+ <<"-define(__, _, _).\n"
+ "-define(FF, ?FUNCTION_NAME, ?FUNCTION_ARITY).\n"
+ "a(?__) -> 2 = ?FUNCTION_ARITY.\n"
+ "b(?FUNCTION_ARITY, ?__) -> ok.\n"
+ "c(?FF) -> ok.\n"
+ "t() -> a(1, 2), b(3, 1, 2), c(c, 2), ok.\n">>,
+ ok}
+ ],
+ [] = run(Config, Ts),
+
+ ok.
+
check(Config, Tests) ->
eval_tests(Config, fun check_test/2, Tests).
@@ -1504,15 +1602,17 @@ eval_tests(Config, Fun, Tests) ->
check_test(Config, Test) ->
Filename = "epp_test.erl",
- ?line PrivDir = ?config(priv_dir, Config),
- ?line File = filename:join(PrivDir, Filename),
- ?line ok = file:write_file(File, Test),
- ?line case epp:parse_file(File, [PrivDir], []) of
- {ok,Forms} ->
- [E || E={error,_} <- Forms];
- {error,Error} ->
- Error
- end.
+ PrivDir = ?config(priv_dir, Config),
+ File = filename:join(PrivDir, Filename),
+ ok = file:write_file(File, Test),
+ case epp:parse_file(File, [PrivDir], []) of
+ {ok,Forms} ->
+ Errors = [E || E={error,_} <- Forms],
+ call_format_error([E || {error,E} <- Errors]),
+ Errors;
+ {error,Error} ->
+ Error
+ end.
compile_test(Config, Test0) ->
Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0],
@@ -1528,8 +1628,11 @@ compile_test(Config, Test0) ->
warnings(File, Ws) ->
case lists:append([W || {F, W} <- Ws, F =:= File]) of
- [] -> [];
- L -> {warnings, L}
+ [] ->
+ [];
+ L ->
+ call_format_error(L),
+ {warnings, L}
end.
compile_file(File, Opts) ->
@@ -1540,12 +1643,20 @@ compile_file(File, Opts) ->
end.
errs([{File,Es}|L], File) ->
+ call_format_error(Es),
Es ++ errs(L, File);
errs([_|L], File) ->
errs(L, File);
errs([], _File) ->
[].
+%% Smoke test and coverage of format_error/1.
+call_format_error([{_,M,E}|T]) ->
+ _ = M:format_error(E),
+ call_format_error(T);
+call_format_error([]) ->
+ ok.
+
epp_parse_file(File, Opts) ->
case epp:parse_file(File, Opts) of
{ok, Forms} ->
diff --git a/lib/stdlib/test/erl_anno_SUITE.erl b/lib/stdlib/test/erl_anno_SUITE.erl
index 66b02151a0..79b27c6217 100644
--- a/lib/stdlib/test/erl_anno_SUITE.erl
+++ b/lib/stdlib/test/erl_anno_SUITE.erl
@@ -22,10 +22,10 @@
%-define(debug, true).
-ifdef(debug).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), io:format(S, A)).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), ok).
-endif.
@@ -34,7 +34,7 @@
init_per_testcase/2, end_per_testcase/2]).
-export([new/1, is_anno/1, generated/1, end_location/1, file/1,
- line/1, location/1, record/1, text/1, bad/1, neg_line/1]).
+ line/1, location/1, record/1, text/1, bad/1]).
-export([parse_abstract/1, mapfold_anno/1]).
@@ -43,7 +43,7 @@ all() ->
groups() ->
[{anno, [], [new, is_anno, generated, end_location, file,
- line, location, record, text, bad, neg_line]},
+ line, location, record, text, bad]},
{parse, [], [parse_abstract, mapfold_anno]}].
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -229,74 +229,6 @@ bad(_Config) ->
(catch erl_anno:record(bad)), % 1st arg not opaque
ok.
-neg_line(doc) ->
- ["Test negative line numbers (OTP 18)"];
-neg_line(_Config) ->
- neg_line1(false),
- neg_line1(true),
- ok.
-
-neg_line1(TextToo) ->
- Minus8_0 = erl_anno:new(-8),
- Plus8_0 = erl_anno:new(8),
- Minus8C_0 = erl_anno:new({-8, 17}),
- Plus8C_0 = erl_anno:new({8, 17}),
-
- [Minus8, Plus8, Minus8C, Plus8C] =
- [case TextToo of
- true ->
- erl_anno:set_text("foo", A);
- false ->
- A
- end || A <- [Minus8_0, Plus8_0, Minus8C_0, Plus8C_0]],
-
- tst(-3, erl_anno:set_location(3, Minus8)),
- tst(-3, erl_anno:set_location(-3, Plus8)),
- tst(-3, erl_anno:set_location(-3, Minus8)),
- tst({-3,9}, erl_anno:set_location({3, 9}, Minus8)),
- tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8)),
- tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8)),
- tst(-3, erl_anno:set_location(3, Minus8C)),
- tst(-3, erl_anno:set_location(-3, Plus8C)),
- tst(-3, erl_anno:set_location(-3, Minus8C)),
- tst({-3,9}, erl_anno:set_location({3, 9}, Minus8C)),
- tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8C)),
- tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8C)),
-
- tst(-8, erl_anno:set_generated(true, Plus8)),
- tst(-8, erl_anno:set_generated(true, Minus8)),
- tst({-8,17}, erl_anno:set_generated(true, Plus8C)),
- tst({-8,17}, erl_anno:set_generated(true, Minus8C)),
- tst(8, erl_anno:set_generated(false, Plus8)),
- tst(8, erl_anno:set_generated(false, Minus8)),
- tst({8,17}, erl_anno:set_generated(false, Plus8C)),
- tst({8,17}, erl_anno:set_generated(false, Minus8C)),
-
- tst(-3, erl_anno:set_line(3, Minus8)),
- tst(-3, erl_anno:set_line(-3, Plus8)),
- tst(-3, erl_anno:set_line(-3, Minus8)),
- tst({-3,17}, erl_anno:set_line(3, Minus8C)),
- tst({-3,17}, erl_anno:set_line(-3, Plus8C)),
- tst({-3,17}, erl_anno:set_line(-3, Minus8C)),
- ok.
-
-tst(Term, Anno) ->
- ?format("Term: ~p\n", [Term]),
- ?format("Anno: ~p\n", [Anno]),
- case anno_to_term(Anno) of
- Term ->
- ok;
- Else ->
- case lists:keyfind(location, 1, Else) of
- {location, Term} ->
- ok;
- _Else2 ->
- ?format("Else2 ~p\n", [_Else2]),
- io:format("expected ~p\n got ~p\n", [Term, Else]),
- exit({Term, Else})
- end
- end.
-
parse_abstract(doc) ->
["Test erl_parse:new_anno/1, erl_parse:anno_to_term/1"
", and erl_parse:anno_from_term/1"];
diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl
index c21c4e61ee..1874ee1a1d 100644
--- a/lib/stdlib/test/erl_eval_SUITE.erl
+++ b/lib/stdlib/test/erl_eval_SUITE.erl
@@ -64,7 +64,7 @@
config(priv_dir,_) ->
".".
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init_per_testcase/2, end_per_testcase/2]).
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/stdlib/test/erl_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl
index 8cec445cb4..2cc4757c04 100644
--- a/lib/stdlib/test/erl_expand_records_SUITE.erl
+++ b/lib/stdlib/test/erl_expand_records_SUITE.erl
@@ -28,7 +28,7 @@
-define(privdir, "erl_expand_records_SUITE_priv").
-define(t, test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(privdir, ?config(priv_dir, Config)).
-endif.
diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl
index 0d2f535040..ad0b37aae3 100644
--- a/lib/stdlib/test/erl_internal_SUITE.erl
+++ b/lib/stdlib/test/erl_internal_SUITE.erl
@@ -26,7 +26,7 @@
-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]}].
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index 375fb6bc93..d946469625 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -28,7 +28,7 @@
-define(privdir, "erl_lint_SUITE_priv").
-define(t, test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(datadir, ?config(data_dir, Conf)).
-define(privdir, ?config(priv_dir, Conf)).
-endif.
@@ -65,7 +65,8 @@
too_many_arguments/1,
basic_errors/1,bin_syntax_errors/1,
predef/1,
- maps/1,maps_type/1,otp_11851/1,otp_12195/1, otp_13230/1
+ maps/1,maps_type/1,otp_11851/1,otp_11879/1,otp_13230/1,
+ record_errors/1
]).
% Default timetrap timeout (set in init_per_testcase).
@@ -94,7 +95,8 @@ all() ->
bif_clash, behaviour_basic, behaviour_multiple, otp_11861,
otp_7550, otp_8051, format_warn, {group, on_load},
too_many_arguments, basic_errors, bin_syntax_errors, predef,
- maps, maps_type, otp_11851, otp_12195, otp_13230].
+ maps, maps_type, otp_11851, otp_11879, otp_13230,
+ record_errors].
groups() ->
[{unused_vars_warn, [],
@@ -1296,12 +1298,16 @@ unsized_binary_in_bin_gen_pattern(Config) when is_list(Config) ->
Ts = [{unsized_binary_in_bin_gen_pattern,
<<"t({bc,binary,Bin}) ->
<< <<X,Tail/binary>> || <<X,Tail/binary>> <= Bin >>;
+ t({bc,bytes,Bin}) ->
+ << <<X,Tail/binary>> || <<X,Tail/bytes>> <= Bin >>;
t({bc,bits,Bin}) ->
<< <<X,Tail/bits>> || <<X,Tail/bits>> <= Bin >>;
t({bc,bitstring,Bin}) ->
<< <<X,Tail/bits>> || <<X,Tail/bitstring>> <= Bin >>;
t({lc,binary,Bin}) ->
[ {X,Tail} || <<X,Tail/binary>> <= Bin ];
+ t({lc,bytes,Bin}) ->
+ [ {X,Tail} || <<X,Tail/bytes>> <= Bin ];
t({lc,bits,Bin}) ->
[ {X,Tail} || <<X,Tail/bits>> <= Bin ];
t({lc,bitstring,Bin}) ->
@@ -1313,7 +1319,9 @@ unsized_binary_in_bin_gen_pattern(Config) when is_list(Config) ->
{6,erl_lint,unsized_binary_in_bin_gen_pattern},
{8,erl_lint,unsized_binary_in_bin_gen_pattern},
{10,erl_lint,unsized_binary_in_bin_gen_pattern},
- {12,erl_lint,unsized_binary_in_bin_gen_pattern}],
+ {12,erl_lint,unsized_binary_in_bin_gen_pattern},
+ {14,erl_lint,unsized_binary_in_bin_gen_pattern},
+ {16,erl_lint,unsized_binary_in_bin_gen_pattern}],
[]}}],
[] = run(Config, Ts),
ok.
@@ -2599,6 +2607,23 @@ otp_5878(Config) when is_list(Config) ->
">>,
?line [] = run_test2(Config, UsedByType, [warn_unused_record]),
+ %% Abstract code generated by OTP 18. Note that the type info for
+ %% record fields has been put in a separate form.
+ OldAbstract = [{attribute,1,file,{"rec.erl",1}},
+ {attribute,1,module,rec},
+ {attribute,3,export,[{t,0}]},
+ {attribute,7,record,{r,[{record_field,7,{atom,7,f}}]}},
+ {attribute,7,type,
+ {{record,r},
+ [{typed_record_field,
+ {record_field,7,{atom,7,f}},
+ {type,7,union,[{atom,7,undefined},{type,7,atom,[]}]}}],
+ []}},
+ {function,9,t,0,[{clause,9,[],[],[{record,10,r,[]}]}]},
+ {eof,11}],
+ {error,[{"rec.erl",[{7,erl_lint,old_abstract_code}]}],[]} =
+ compile:forms(OldAbstract, [return, report]),
+
ok.
otp_6885(doc) ->
@@ -3843,38 +3868,27 @@ otp_11851(Config) when is_list(Config) ->
[] = run(Config, Ts),
ok.
-otp_12195(doc) ->
- "OTP-12195: Check obsolete types (tailor made for OTP 18).";
-otp_12195(Config) when is_list(Config) ->
- Ts = [{otp_12195_1,
- <<"-export_type([r1/0]).
- -type r1() :: erl_scan:line()
- | erl_scan:column()
- | erl_scan:location()
- | erl_anno:line().">>,
- [],
- {warnings,[{2,erl_lint,
- {deprecated_type,{erl_scan,line,0},
- "deprecated (will be removed in OTP 19); "
- "use erl_anno:line() instead"}},
- {3,erl_lint,
- {deprecated_type,{erl_scan,column,0},
- "deprecated (will be removed in OTP 19); use "
- "erl_anno:column() instead"}},
- {4,erl_lint,
- {deprecated_type,{erl_scan,location,0},
- "deprecated (will be removed in OTP 19); "
- "use erl_anno:location() instead"}}]}},
- {otp_12195_2,
- <<"-export_type([r1/0]).
- -compile(nowarn_deprecated_type).
- -type r1() :: erl_scan:line()
- | erl_scan:column()
- | erl_scan:location()
- | erl_anno:line().">>,
- [],
- []}],
- [] = run(Config, Ts),
+otp_11879(doc) ->
+ "OTP-11879: The -spec f/a :: (As) -> B; syntax removed, "
+ "and is_subtype/2 deprecated";
+otp_11879(_Config) ->
+ Fs = [{attribute,0,file,{"file.erl",0}},
+ {attribute,0,module,m},
+ {attribute,1,spec,
+ {{f,1},
+ [{type,2,'fun',[{type,3,product,[{var,4,'V1'},
+ {var,5,'V1'}]},
+ {type,6,integer,[]}]}]}},
+ {attribute,20,callback,
+ {{cb,21},
+ [{type,22,'fun',[{type,23,product,[{var,24,'V1'},
+ {var,25,'V1'}]},
+ {type,6,integer,[]}]}]}}],
+ {error,[{"file.erl",
+ [{1,erl_lint,{spec_fun_undefined,{f,1}}},
+ {2,erl_lint,spec_wrong_arity},
+ {22,erl_lint,callback_wrong_arity}]}],
+ []} = compile:forms(Fs, [return,report]),
ok.
otp_13230(doc) ->
@@ -3886,6 +3900,17 @@ otp_13230(Config) when is_list(Config) ->
[]} = run_test2(Config, Abstr, []),
ok.
+record_errors(Config) when is_list(Config) ->
+ Ts = [{rec1,
+ <<"-record(r, {a,b}).
+ b() -> #r{a=foo,b=42,a=bar}.
+ u(R) -> R#r{a=1,b=2,a=2}.
+ ">>,
+ [],
+ {errors,[{2,erl_lint,{redefine_field,r,a}},
+ {3,erl_lint,{redefine_field,r,a}}],[]}}],
+ run(Config, Ts).
+
run(Config, Tests) ->
F = fun({N,P,Ws,E}, BadL) ->
case catch run_test(Config, P, Ws) of
diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl
index 92e2764c65..f7418b1f5f 100644
--- a/lib/stdlib/test/erl_pp_SUITE.erl
+++ b/lib/stdlib/test/erl_pp_SUITE.erl
@@ -31,7 +31,7 @@
-define(privdir, "erl_pp_SUITE_priv").
-define(t, test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(datadir, ?config(data_dir, Config)).
-define(privdir, ?config(priv_dir, Config)).
-endif.
@@ -876,6 +876,9 @@ type_examples() ->
{ex30,<<"-type t99() ::"
"{t2(),'\\'t::4'(),t5(),t6(),t7(),t8(),t10(),t14(),"
"t15(),t20(),t21(), t22(),t25()}. ">>},
+ %% Writing constraints as is_subtype(V, T) is not supported since
+ %% Erlang/OTP 19.0, but as long as the parser recognizes the
+ %% is_subtype(V, T) syntax, we need a few examples of the syntax.
{ex31,<<"-spec t1(FooBar :: t99()) -> t99();"
"(t2()) -> t2();"
"('\\'t::4'()) -> '\\'t::4'() when is_subtype('\\'t::4'(), t24);"
@@ -928,7 +931,9 @@ otp_8522(Config) when is_list(Config) ->
?line {ok, _} = compile:file(FileName, [{outdir,?privdir},debug_info]),
BF = filename("otp_8522", Config),
?line {ok, A} = beam_lib:chunks(BF, [abstract_code]),
- ?line 5 = count_atom(A, undefined),
+ %% OTP-12719: Since 'undefined' is no longer added by the Erlang
+ %% Parser, the number of 'undefined' is 4. It used to be 5.
+ ?line 4 = count_atom(A, undefined),
ok.
count_atom(A, A) ->
@@ -998,18 +1003,10 @@ otp_8567(Config) when is_list(Config) ->
"t() ->\n"
" 3.\n"
"\n"
- "-spec(t1/1 :: (ot()) -> ot1()).\n"
- "t1(A) ->\n"
- " A.\n"
- "\n"
"-spec(t2 (ot()) -> ot1()).\n"
"t2(A) ->\n"
" A.\n"
"\n"
- "-spec(otp_8567:t3/1 :: (ot()) -> ot1()).\n"
- "t3(A) ->\n"
- " A.\n"
- "\n"
"-spec(otp_8567:t4 (ot()) -> ot1()).\n"
"t4(A) ->\n"
" A.\n">>,
@@ -1065,7 +1062,7 @@ otp_9147(Config) when is_list(Config) ->
?line {ok, Bin} = file:read_file(PFileName),
%% The parentheses around "F1 :: a | b" are new (bugfix).
?line true =
- lists:member("-record(undef,{f1 :: undefined | (F1 :: a | b)}).",
+ lists:member("-record(undef,{f1 :: F1 :: a | b}).",
string:tokens(binary_to_list(Bin), "\n")),
ok.
diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl
index 12ea3d128c..941703b5dd 100644
--- a/lib/stdlib/test/erl_scan_SUITE.erl
+++ b/lib/stdlib/test/erl_scan_SUITE.erl
@@ -42,7 +42,7 @@
%% config(data_dir, _) ->
%% ".".
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init_per_testcase/2, end_per_testcase/2]).
init_per_testcase(_Case, Config) when is_list(Config) ->
@@ -191,8 +191,7 @@ otp_7810(Config) when is_list(Config) ->
?line ok = more_chars(),
?line ok = more_options(),
- ?line ok = attributes_info(),
- ?line ok = set_attribute(),
+ ?line ok = anno_info(),
ok.
@@ -269,7 +268,7 @@ punctuations() ->
comments() ->
?line test("a %%\n b"),
- {ok,[],1} = erl_scan_string("%"),
+ ?line {ok,[],1} = erl_scan_string("%"),
?line test("a %%\n b"),
{ok,[{atom,{1,1},a},{atom,{2,2},b}],{2,3}} =
erl_scan_string("a %%\n b", {1,1}),
@@ -338,7 +337,7 @@ base_integers() ->
erl_scan:string(Str)
end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ],
- {ok,[{integer,1,239},{'@',1}],1} = erl_scan_string("16#ef@"),
+ ?line {ok,[{integer,1,239},{'@',1}],1} = erl_scan_string("16#ef@"),
{ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} =
erl_scan_string("16#ef@", {1,1}, []),
{ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} =
@@ -387,20 +386,15 @@ dots() ->
R2 = erl_scan_string(S, {1,1}, [])
end || {S, R, R2} <- Dot],
- ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text),
- ?line [{column,1},{length,1},{line,1},{text,"."}] =
- erl_scan:token_info(T1, [column, length, line, text]),
- ?line {ok,[{dot,_}=T2],{1,3}} = erl_scan:string(".%", {1,1}, text),
- ?line [{column,1},{length,1},{line,1},{text,"."}] =
- erl_scan:token_info(T2, [column, length, line, text]),
- ?line {ok,[{dot,_}=T3],{1,6}} =
+ {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text),
+ [1, 1, "."] = token_info(T1),
+ {ok,[{dot,_}=T2],{1,3}} = erl_scan:string(".%", {1,1}, text),
+ [1, 1, "."] = token_info(T2),
+ {ok,[{dot,_}=T3],{1,6}} =
erl_scan:string(".% öh", {1,1}, text),
- ?line [{column,1},{length,1},{line,1},{text,"."}] =
- erl_scan:token_info(T3, [column, length, line, text]),
- ?line {error,{{1,2},erl_scan,char},{1,3}} =
- erl_scan:string(".$", {1,1}),
- ?line {error,{{1,2},erl_scan,char},{1,4}} =
- erl_scan:string(".$\\", {1,1}),
+ [1, 1, "."] = token_info(T3),
+ {error,{{1,2},erl_scan,char},{1,3}} = erl_scan:string(".$", {1,1}),
+ {error,{{1,2},erl_scan,char},{1,4}} = erl_scan:string(".$\\", {1,1}),
test_string(". ", [{dot,{1,1}}]),
test_string(". ", [{dot,{1,1}}]),
@@ -413,18 +407,18 @@ dots() ->
test_string(".a", [{'.',{1,1}},{atom,{1,2},a}]),
test_string("%. \n. ", [{dot,{2,1}}]),
- ?line {more,C} = erl_scan:tokens([], "%. ",{1,1}, return),
+ {more,C} = erl_scan:tokens([], "%. ",{1,1}, return),
{done,{ok,[{comment,{1,1},"%. "},
{white_space,{1,4},"\n"},
{dot,{2,1}}],
{2,3}}, ""} =
erl_scan_tokens(C, "\n. ", {1,1}, return), % any loc, any options
- ?line [test_string(S, R) ||
- {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]},
- {"$\\\n", [{char,{1,1},$\n}]},
- {"'\\\n'", [{atom,{1,1},'\n'}]},
- {"$\n", [{char,{1,1},$\n}]}] ],
+ [test_string(S, R) ||
+ {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]},
+ {"$\\\n", [{char,{1,1},$\n}]},
+ {"'\\\n'", [{atom,{1,1},'\n'}]},
+ {"$\n", [{char,{1,1},$\n}]}] ],
ok.
chars() ->
@@ -540,8 +534,8 @@ eof() ->
%% A dot followed by eof is special:
?line {more, C} = erl_scan:tokens([], "a.", 1),
- {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan_tokens(C,eof,1),
- {ok,[{atom,1,foo},{dot,1}],1} = erl_scan_string("foo."),
+ ?line {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan_tokens(C,eof,1),
+ ?line {ok,[{atom,1,foo},{dot,1}],1} = erl_scan_string("foo."),
%% With column.
{more, CCol} = erl_scan:tokens([], "a.", {1,1}),
@@ -655,145 +649,72 @@ options() ->
ok.
more_options() ->
- ?line {ok,[{atom,A1,foo}],{19,20}} =
+ {ok,[{atom,_,foo}=T1],{19,20}} =
erl_scan:string("foo", {19,17},[]),
- ?line [{column,17},{line,19}] = erl_scan:attributes_info(A1),
- ?line {done,{ok,[{atom,A2,foo},{dot,_}],{19,22}},[]} =
+ {19,17} = erl_scan:location(T1),
+ {done,{ok,[{atom,_,foo}=T2,{dot,_}],{19,22}},[]} =
erl_scan:tokens([], "foo. ", {19,17}, [bad_opt]), % type error
- ?line [{column,17},{line,19}] = erl_scan:attributes_info(A2),
- ?line {ok,[{atom,A3,foo}],{19,20}} =
+ {19,17} = erl_scan:location(T2),
+ {ok,[{atom,_,foo}=T3],{19,20}} =
erl_scan:string("foo", {19,17},[text]),
- ?line [{column,17},{length,3},{line,19},{text,"foo"}] =
- erl_scan:attributes_info(A3),
+ {19,17} = erl_scan:location(T3),
+ "foo" = erl_scan:text(T3),
- ?line {ok,[{atom,A4,foo}],1} = erl_scan:string("foo", 1, [text]),
- ?line [{length,3},{line,1},{text,"foo"}] = erl_scan:attributes_info(A4),
+ {ok,[{atom,_,foo}=T4],1} = erl_scan:string("foo", 1, [text]),
+ 1 = erl_scan:line(T4),
+ 1 = erl_scan:location(T4),
+ "foo" = erl_scan:text(T4),
ok.
token_info() ->
- ?line {ok,[T1],_} = erl_scan:string("foo", {1,18}, [text]),
+ {ok,[T1],_} = erl_scan:string("foo", {1,18}, [text]),
{'EXIT',{badarg,_}} =
- (catch {foo, erl_scan:token_info(T1, foo)}), % type error
- ?line {line,1} = erl_scan:token_info(T1, line),
- ?line {column,18} = erl_scan:token_info(T1, column),
- ?line {length,3} = erl_scan:token_info(T1, length),
- ?line {text,"foo"} = erl_scan:token_info(T1, text),
- ?line [{category,atom},{column,18},{length,3},{line,1},
- {symbol,foo},{text,"foo"}] =
- erl_scan:token_info(T1),
- ?line [{length,3},{column,18}] =
- erl_scan:token_info(T1, [length, column]),
- ?line [{location,{1,18}}] =
- erl_scan:token_info(T1, [location]),
- ?line {category,atom} = erl_scan:token_info(T1, category),
- ?line [{symbol,foo}] = erl_scan:token_info(T1, [symbol]),
-
- ?line {ok,[T2],_} = erl_scan:string("foo", 1, []),
- ?line {line,1} = erl_scan:token_info(T2, line),
- ?line undefined = erl_scan:token_info(T2, column),
- ?line undefined = erl_scan:token_info(T2, length),
- ?line undefined = erl_scan:token_info(T2, text),
- ?line {location,1} = erl_scan:token_info(T2, location),
- ?line [{category,atom},{line,1},{symbol,foo}] = erl_scan:token_info(T2),
- ?line [{line,1}] = erl_scan:token_info(T2, [length, line]),
-
- ?line {ok,[T3],_} = erl_scan:string("=", 1, []),
- ?line [{line,1}] = erl_scan:token_info(T3, [column, line]),
- ?line {category,'='} = erl_scan:token_info(T3, category),
- ?line [{symbol,'='}] = erl_scan:token_info(T3, [symbol]),
+ (catch {foo, erl_scan:category(foo)}), % type error
+ {'EXIT',{badarg,_}} =
+ (catch {foo, erl_scan:symbol(foo)}), % type error
+ atom = erl_scan:category(T1),
+ foo = erl_scan:symbol(T1),
+
+ {ok,[T2],_} = erl_scan:string("foo", 1, []),
+ 1 = erl_scan:line(T2),
+ undefined = erl_scan:column(T2),
+ undefined = erl_scan:text(T2),
+ 1 = erl_scan:location(T2),
+
+ {ok,[T3],_} = erl_scan:string("=", 1, []),
+ '=' = erl_scan:category(T3),
+ '=' = erl_scan:symbol(T3),
ok.
-attributes_info() ->
- ?line {'EXIT',_} =
- (catch {foo,erl_scan:attributes_info(foo)}), % type error
- [{line,18}] = erl_scan:attributes_info(erl_anno:new(18)),
- {location,19} =
- erl_scan:attributes_info(erl_anno:new(19), location),
- ?line {ok,[{atom,A0,foo}],_} = erl_scan:string("foo", 19, [text]),
- ?line {location,19} = erl_scan:attributes_info(A0, location),
-
- ?line {ok,[{atom,A3,foo}],_} = erl_scan:string("foo", {1,3}, [text]),
- ?line {line,1} = erl_scan:attributes_info(A3, line),
- ?line {column,3} = erl_scan:attributes_info(A3, column),
- ?line {location,{1,3}} = erl_scan:attributes_info(A3, location),
- ?line {text,"foo"} = erl_scan:attributes_info(A3, text),
-
- ?line {ok,[{atom,A4,foo}],_} = erl_scan:string("foo", 2, [text]),
- ?line {line,2} = erl_scan:attributes_info(A4, line),
- ?line undefined = erl_scan:attributes_info(A4, column),
- ?line {location,2} = erl_scan:attributes_info(A4, location),
- ?line {text,"foo"} = erl_scan:attributes_info(A4, text),
-
- ?line {ok,[{atom,A5,foo}],_} = erl_scan:string("foo", {1,3}, []),
- ?line {line,1} = erl_scan:attributes_info(A5, line),
- ?line {column,3} = erl_scan:attributes_info(A5, column),
- ?line {location,{1,3}} = erl_scan:attributes_info(A5, location),
- ?line undefined = erl_scan:attributes_info(A5, text),
-
- ?line undefined = erl_scan:attributes_info([], line), % type error
+anno_info() ->
+ {'EXIT',_} =
+ (catch {foo,erl_scan:line(foo)}), % type error
+ {ok,[{atom,_,foo}=T0],_} = erl_scan:string("foo", 19, [text]),
+ 19 = erl_scan:location(T0),
+ 19 = erl_scan:end_location(T0),
+
+ {ok,[{atom,_,foo}=T3],_} = erl_scan:string("foo", {1,3}, [text]),
+ 1 = erl_scan:line(T3),
+ 3 = erl_scan:column(T3),
+ {1,3} = erl_scan:location(T3),
+ {1,6} = erl_scan:end_location(T3),
+ "foo" = erl_scan:text(T3),
+
+ {ok,[{atom,_,foo}=T4],_} = erl_scan:string("foo", 2, [text]),
+ 2 = erl_scan:line(T4),
+ undefined = erl_scan:column(T4),
+ 2 = erl_scan:location(T4),
+ "foo" = erl_scan:text(T4),
+
+ {ok,[{atom,_,foo}=T5],_} = erl_scan:string("foo", {1,3}, []),
+ 1 = erl_scan:line(T5),
+ 3 = erl_scan:column(T5),
+ {1,3} = erl_scan:location(T5),
+ undefined = erl_scan:text(T5),
ok.
-set_attribute() ->
- F = fun(Line) -> -Line end,
- Anno2 = erl_anno:new(2),
- A0 = erl_scan:set_attribute(line, Anno2, F),
- {line, -2} = erl_scan:attributes_info(A0, line),
- ?line {ok,[{atom,A1,foo}],_} = erl_scan:string("foo", {9,17}),
- ?line A2 = erl_scan:set_attribute(line, A1, F),
- ?line {line,-9} = erl_scan:attributes_info(A2, line),
- ?line {location,{-9,17}} = erl_scan:attributes_info(A2, location),
- ?line [{line,-9},{column,17}] =
- erl_scan:attributes_info(A2, [line,column,text]),
-
- F2 = fun(Line) -> {17,Line} end,
- ?line Attr1 = erl_scan:set_attribute(line, 2, F2),
- ?line {line,{17,2}} = erl_scan:attributes_info(Attr1, line),
- ?line undefined = erl_scan:attributes_info(Attr1, column),
- ?line {location,{17,2}} = % a bit mixed up
- erl_scan:attributes_info(Attr1, location),
-
- ?line A3 = erl_scan:set_attribute(line, A1, F2),
- ?line {line,{17,9}} = erl_scan:attributes_info(A3, line),
- ?line {location,{{17,9},17}} = erl_scan:attributes_info(A3, location),
- ?line [{line,{17,9}},{column,17}] =
- erl_scan:attributes_info(A3, [line,column,text]),
-
- ?line {ok,[{atom,A4,foo}],_} = erl_scan:string("foo", {9,17}, [text]),
- ?line A5 = erl_scan:set_attribute(line, A4, F),
- ?line {line,-9} = erl_scan:attributes_info(A5, line),
- ?line {location,{-9,17}} = erl_scan:attributes_info(A5, location),
- ?line [{line,-9},{column,17},{text,"foo"}] =
- erl_scan:attributes_info(A5, [line,column,text]),
-
- ?line {ok,[{atom,A6,foo}],_} = erl_scan:string("foo", 11, [text]),
- ?line A7 = erl_scan:set_attribute(line, A6, F2),
- %% Incompatible with pre 18:
- %% {line,{17,11}} = erl_scan:attributes_info(A7, line),
- {line,17} = erl_scan:attributes_info(A7, line),
- ?line {location,{17,11}} = % mixed up
- erl_scan:attributes_info(A7, location),
- %% Incompatible with pre 18:
- %% [{line,{17,11}},{text,"foo"}] =
- %% erl_scan:attributes_info(A7, [line,column,text]),
- [{line,17},{column,11},{text,"foo"}] =
- erl_scan:attributes_info(A7, [line,column,text]),
-
- ?line {'EXIT',_} =
- (catch {foo, erl_scan:set_attribute(line, [], F2)}), % type error
- ?line {'EXIT',{badarg,_}} =
- (catch {foo, erl_scan:set_attribute(column, [], F2)}), % type error
-
- Attr10 = erl_anno:new(8),
- Attr20 = erl_scan:set_attribute(line, Attr10,
- fun(L) -> {nos,'X',L} end),
- %% OTP-9412
- Attr30 = erl_scan:set_attribute(line, Attr20,
- fun({nos,_V,VL}) -> VL end),
- 8 = erl_anno:to_term(Attr30),
- ok.
-
column_errors() ->
?line {error,{{1,1},erl_scan,{string,$',""}},{1,3}} = % $'
erl_scan:string("'\\",{1,1}),
@@ -892,14 +813,13 @@ unicode() ->
erl_scan_string(Qs, 1),
{ok,[Q2],{1,9}} =
erl_scan:string("$\\x{aaa}", {1,1}, [text]),
- [{category,char},{column,1},{length,8},
- {line,1},{symbol,16#aaa},{text,Qs}] =
- erl_scan:token_info(Q2),
+ [{category,char},{column,1},{line,1},{symbol,16#aaa},{text,Qs}] =
+ token_info_long(Q2),
U1 = "\"\\x{aaa}\"",
- {ok,[{string,A1,[2730]}],{1,10}} = erl_scan:string(U1, {1,1}, [text]),
- [{line,1},{column,1},{text,"\"\\x{aaa}\""}] =
- erl_scan:attributes_info(A1, [line, column, text]),
+ {ok,[{string,_,[2730]}=T1],{1,10}} = erl_scan:string(U1, {1,1}, [text]),
+ {1,1} = erl_scan:location(T1),
+ "\"\\x{aaa}\"" = erl_scan:text(T1),
{ok,[{string,1,[2730]}],1} = erl_scan_string(U1, 1),
U2 = "\"\\x41\\x{fff}\\x42\"",
@@ -1012,16 +932,13 @@ otp_10302(Config) when is_list(Config) ->
Qs = "$\\x{aaa}",
{ok,[{char,1,2730}],1} = erl_scan_string(Qs, 1),
{ok,[Q2],{1,9}} = erl_scan:string(Qs,{1,1},[text]),
- [{category,char},{column,1},{length,8},
- {line,1},{symbol,16#aaa},{text,Qs}] =
- erl_scan:token_info(Q2),
-
- Tags = [category, column, length, line, symbol, text],
+ [{category,char},{column,1},{line,1},{symbol,16#aaa},{text,Qs}] =
+ token_info_long(Q2),
U1 = "\"\\x{aaa}\"",
{ok,[T1],{1,10}} = erl_scan:string(U1, {1,1}, [text]),
- [{category,string},{column,1},{length,9},{line,1},
- {symbol,[16#aaa]},{text,U1}] = erl_scan:token_info(T1, Tags),
+ [{category,string},{column,1},{line,1},{symbol,[16#aaa]},{text,U1}] =
+ token_info_long(T1),
U2 = "\"\\x41\\x{fff}\\x42\"",
{ok,[{string,1,[65,4095,66]}],1} = erl_scan_string(U2, 1),
@@ -1353,9 +1270,7 @@ test_wsc([], []) ->
ok;
test_wsc([Token|Tokens], [Token2|Tokens2]) ->
[Text, Text2] = [Text ||
- {text, Text} <-
- [erl_scan:token_info(T, text) ||
- T <- [Token, Token2]]],
+ Text <- [erl_scan:text(T) || T <- [Token, Token2]]],
Sz = erts_debug:size(Text),
Sz2 = erts_debug:size({Text, Text2}),
IsCompacted = Sz2 < 2*Sz+erts_debug:size({a,a}),
@@ -1394,7 +1309,7 @@ all_same(L, Char) ->
newlines_first([]) ->
ok;
newlines_first([Token|Tokens]) ->
- {text,Text} = erl_scan:token_info(Token, text),
+ Text = erl_scan:text(Token),
Nnls = length([C || C <- Text, C =:= $\n]),
OK = case Text of
[$\n|_] ->
@@ -1414,7 +1329,7 @@ select_tokens(Tokens, Tags) ->
lists:filter(fun(T) -> lists:member(element(1, T), Tags) end, Tokens).
simplify([Token|Tokens]) ->
- {line,Line} = erl_scan:token_info(Token, line),
+ Line = erl_scan:line(Token),
[setelement(2, Token, erl_anno:new(Line)) | simplify(Tokens)];
simplify([]) ->
[].
@@ -1423,17 +1338,31 @@ get_text(Tokens) ->
lists:flatten(
[T ||
Token <- Tokens,
- ({text,T} = erl_scan:token_info(Token, text)) =/= []]).
+ (T = erl_scan:text(Token)) =/= []]).
test_decorated_tokens(String, Tokens) ->
ToksAttrs = token_attrs(Tokens),
test_strings(ToksAttrs, String, 1, 1).
token_attrs(Tokens) ->
- [{L,C,Len,T} ||
+ [{L,C,length(T),T} ||
Token <- Tokens,
- ([{line,L},{column,C},{length,Len},{text,T}] =
- erl_scan:token_info(Token, [line,column,length,text])) =/= []].
+ ([C,L,T] = token_info(Token)) =/= []].
+
+token_info(T) ->
+ Column = erl_scan:column(T),
+ Line = erl_scan:line(T),
+ Text = erl_scan:text(T),
+ [Column, Line, Text].
+
+token_info_long(T) ->
+ Column = erl_scan:column(T),
+ Line = erl_scan:line(T),
+ Text = erl_scan:text(T),
+ Category = erl_scan:category(T),
+ Symbol = erl_scan:symbol(T),
+ [{category,Category},{column,Column},{line,Line},
+ {symbol,Symbol},{text,Text}].
test_strings([], _S, Line, Column) ->
{Line,Column};
@@ -1514,8 +1443,7 @@ consistent_attributes([Ts | TsL]) ->
L = [T || T <- Ts, is_integer(element(2, T))],
case L of
[] ->
- TagsL = [[Tag || {Tag,_} <-
- erl_scan:attributes_info(element(2, T))] ||
+ TagsL = [[Tag || {Tag,_} <- defined(token_info_long(T))] ||
T <- Ts],
case lists:usort(TagsL) of
[_] ->
@@ -1531,6 +1459,9 @@ consistent_attributes([Ts | TsL]) ->
Ts
end.
+defined(L) ->
+ [{T,V} || {T,V} <- L, V =/= undefined].
+
family_list(L) ->
sofs:to_external(family(L)).
diff --git a/lib/stdlib/test/error_logger_h_SUITE.erl b/lib/stdlib/test/error_logger_h_SUITE.erl
index c82b1b62ef..b2f1618ff5 100644
--- a/lib/stdlib/test/error_logger_h_SUITE.erl
+++ b/lib/stdlib/test/error_logger_h_SUITE.erl
@@ -25,7 +25,7 @@
%% Event handler exports.
-export([init/1,handle_event/2,terminate/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl
index 87ff6a68ff..a8d646c044 100644
--- a/lib/stdlib/test/escript_SUITE.erl
+++ b/lib/stdlib/test/escript_SUITE.erl
@@ -40,7 +40,7 @@
unicode/1
]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 30a158d9e1..6f9be9b179 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -107,14 +107,13 @@
-export([t_select_reverse/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(m(A,B), ?line assert_eq(A,B)).
init_per_testcase(Case, Config) ->
- Seed = {S1,S2,S3} = random:seed0(), %now(),
- random:seed(S1,S2,S3),
- io:format("*** SEED: ~p ***\n", [Seed]),
+ rand:seed(exsplus),
+ io:format("*** SEED: ~p ***\n", [rand:export_seed()]),
start_spawn_logger(),
wait_for_test_procs(), %% Ensure previous case cleaned up
Dog=test_server:timetrap(test_server:minutes(20)),
@@ -731,10 +730,6 @@ chk_normal_tab_struct_size() ->
% ?line ok
% end.
--define(DB_TREE_STACK_NEED,50). % The static stack for a tree, in halfword pointers are two internal words
- % so the stack gets twice as big
--define(DB_HASH_SIZEOF_EXTSEG,260). % The segment size in words, in halfword this will be twice as large.
-
adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = _Mem0) ->
%% Adjust for 64-bit, smp, and os:
%% Table struct size may differ.
@@ -748,19 +743,7 @@ adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = _Mem0) ->
% end,
TabDiff = ?TAB_STRUCT_SZ,
- Mem1 = {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff},
-
- case {erlang:system_info({wordsize,internal}),erlang:system_info({wordsize,external})} of
- %% Halfword, corrections for regular pointers occupying two internal words.
- {4,8} ->
- {A1,B1,C1,D1} = Mem1,
- {A1+4*ets:info(T1, size)+?DB_TREE_STACK_NEED,
- B1+3*ets:info(T2, size)+?DB_HASH_SIZEOF_EXTSEG,
- C1+3*ets:info(T3, size)+?DB_HASH_SIZEOF_EXTSEG,
- D1+3*ets:info(T4, size)+?DB_HASH_SIZEOF_EXTSEG};
- _ ->
- Mem1
- end.
+ {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff}.
t_whitebox(doc) ->
["Diverse whitebox testes"];
@@ -1346,7 +1329,7 @@ drop_match() ->
ets_match(Tab,Expr) ->
- case random:uniform(2) of
+ case rand:uniform(2) of
1 ->
ets:match(Tab,Expr);
_ ->
@@ -1355,14 +1338,14 @@ ets_match(Tab,Expr) ->
match_chunked(Tab,Expr) ->
match_chunked_collect(ets:match(Tab,Expr,
- random:uniform(1999) + 1)).
+ rand:uniform(1999) + 1)).
match_chunked_collect('$end_of_table') ->
[];
match_chunked_collect({Results, Continuation}) ->
Results ++ match_chunked_collect(ets:match(Continuation)).
ets_match_object(Tab,Expr) ->
- case random:uniform(2) of
+ case rand:uniform(2) of
1 ->
ets:match_object(Tab,Expr);
_ ->
@@ -1371,7 +1354,7 @@ ets_match_object(Tab,Expr) ->
match_object_chunked(Tab,Expr) ->
match_object_chunked_collect(ets:match_object(Tab,Expr,
- random:uniform(1999) + 1)).
+ rand:uniform(1999) + 1)).
match_object_chunked_collect('$end_of_table') ->
[];
match_object_chunked_collect({Results, Continuation}) ->
@@ -1383,19 +1366,15 @@ random_test() ->
?line ReadDir = get(where_to_read),
?line WriteDir = get(where_to_write),
?line (catch file:make_dir(WriteDir)),
- ?line Seed = case file:consult(filename:join([ReadDir,
- "preset_random_seed.txt"])) of
- {ok,[X]} ->
- X;
- _ ->
- {A,B,C} = erlang:timestamp(),
- random:seed(A,B,C),
- get(random_seed)
- end,
- put(random_seed,Seed),
- ?line {ok, F} = file:open(filename:join([WriteDir,
- "last_random_seed.txt"]),
- [write]),
+ case file:consult(filename:join([ReadDir,"preset_random_seed.txt"])) of
+ {ok,[X]} ->
+ rand:seed(X);
+ _ ->
+ rand:seed(exsplus)
+ end,
+ Seed = rand:export_seed(),
+ {ok,F} = file:open(filename:join([WriteDir,"last_random_seed.txt"]),
+ [write]),
io:format(F,"~p. ~n",[Seed]),
file:close(F),
io:format("Random seed ~p written to ~s, copy to ~s to rerun with "
@@ -1417,7 +1396,7 @@ do_random_test() ->
end, 5000),
?line io:format("~nData inserted~n"),
?line do_n_times(fun() ->
- ?line I = random:uniform(25),
+ I = rand:uniform(25),
?line Key = create_random_string(I) ++ '_',
?line L1 = ets_match_object(OrdSet,{Key,'_'}),
?line L2 = lists:sort(ets_match_object(Set,{Key,'_'})),
@@ -1977,7 +1956,7 @@ evil_update_counter(Config) when is_list(Config) ->
gb_sets:module_info(),
math:module_info(),
ordsets:module_info(),
- random:module_info(),
+ rand:module_info(),
repeat_for_opts(evil_update_counter_do).
@@ -2011,7 +1990,7 @@ evil_counter(I,Opts) ->
1 -> 16#12345678FFFFFFFF;
2 -> 16#7777777777FFFFFFFF863648726743
end,
- Start = Start0 + random:uniform(100000),
+ Start = Start0 + rand:uniform(100000),
ets:insert(T, {dracula,Start}),
Iter = 40000,
End = Start + Iter,
@@ -4684,11 +4663,11 @@ create_random_string(0) ->
[];
create_random_string(OfLength) ->
- C = case random:uniform(2) of
+ C = case rand:uniform(2) of
1 ->
- (random:uniform($Z - $A + 1) - 1) + $A;
+ (rand:uniform($Z - $A + 1) - 1) + $A;
_ ->
- (random:uniform($z - $a + 1) - 1) + $a
+ (rand:uniform($z - $a + 1) - 1) + $a
end,
[C | create_random_string(OfLength - 1)].
@@ -4699,7 +4678,7 @@ create_random_tuple(OfLength) ->
end,create_random_string(OfLength))).
create_partly_bound_tuple(OfLength) ->
- case random:uniform(2) of
+ case rand:uniform(2) of
1 ->
create_partly_bound_tuple1(OfLength);
_ ->
@@ -4708,14 +4687,14 @@ create_partly_bound_tuple(OfLength) ->
create_partly_bound_tuple1(OfLength) ->
T0 = create_random_tuple(OfLength),
- I = random:uniform(OfLength),
+ I = rand:uniform(OfLength),
setelement(I,T0,'$1').
set_n_random_elements(T0,0,_,_) ->
T0;
set_n_random_elements(T0,N,OfLength,GenFun) ->
- I = random:uniform(OfLength),
+ I = rand:uniform(OfLength),
What = GenFun(I),
case element(I,T0) of
What ->
@@ -4729,12 +4708,12 @@ make_dollar_atom(I) ->
list_to_atom([$$] ++ integer_to_list(I)).
create_partly_bound_tuple2(OfLength) ->
T0 = create_random_tuple(OfLength),
- I = random:uniform(OfLength - 1),
+ I = rand:uniform(OfLength - 1),
set_n_random_elements(T0,I,OfLength,fun make_dollar_atom/1).
create_partly_bound_tuple3(OfLength) ->
T0 = create_random_tuple(OfLength),
- I = random:uniform(OfLength - 1),
+ I = rand:uniform(OfLength - 1),
set_n_random_elements(T0,I,OfLength,fun(_) -> '_' end).
do_n_times(_,0) ->
@@ -5097,11 +5076,12 @@ meta_wb_do(Opts) ->
io:format("Colliding names = ~p\n",[Names]),
F = fun(0,_,_) -> ok;
- (N,Tabs,Me) -> Name1 = lists:nth(random:uniform(Len),Names),
- Name2 = lists:nth(random:uniform(Len),Names),
- Op = element(random:uniform(3),OpFuns),
- NTabs = Op(Name1, Name2, Tabs, Opts),
- Me(N-1,NTabs,Me)
+ (N,Tabs,Me) ->
+ Name1 = lists:nth(rand:uniform(Len), Names),
+ Name2 = lists:nth(rand:uniform(Len), Names),
+ Op = element(rand:uniform(3),OpFuns),
+ NTabs = Op(Name1, Name2, Tabs, Opts),
+ Me(N-1, NTabs, Me)
end,
F(Len*100, [], F),
@@ -5367,7 +5347,7 @@ smp_insert(suite) -> [];
smp_insert(Config) when is_list(Config) ->
ets_new(smp_insert,[named_table,public,{write_concurrency,true}]),
InitF = fun(_) -> ok end,
- ExecF = fun(_) -> true = ets:insert(smp_insert,{random:uniform(10000)})
+ ExecF = fun(_) -> true = ets:insert(smp_insert,{rand:uniform(10000)})
end,
FiniF = fun(_) -> ok end,
run_workers(InitF,ExecF,FiniF,100000),
@@ -5618,10 +5598,10 @@ smp_select_delete(Config) when is_list(Config) ->
Zeros = erlang:make_tuple(Mod,0),
InitF = fun(_) -> Zeros end,
ExecF = fun(Diffs0) ->
- case random:uniform(20) of
+ case rand:uniform(20) of
1 ->
Mod = 17,
- Eq = random:uniform(Mod) - 1,
+ Eq = rand:uniform(Mod) - 1,
Deleted = ets:select_delete(T,
[{{'_', '$1'},
[{'=:=', {'rem', '$1', Mod}, Eq}],
@@ -5630,7 +5610,7 @@ smp_select_delete(Config) when is_list(Config) ->
element(Eq+1,Diffs0) - Deleted),
Diffs1;
_ ->
- Key = random:uniform(10000),
+ Key = rand:uniform(10000),
Eq = Key rem Mod,
?line case ets:insert_new(T,{Key,Key}) of
true ->
@@ -5834,7 +5814,7 @@ run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) ->
N when (N > Exclude) -> N - Exclude
end,
io:format("smp starting ~p workers\n",[NumOfProcs]),
- Seeds = [{ProcN,random:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)],
+ Seeds = [{ProcN,rand:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)],
Parent = self(),
Pids = [my_spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end)
|| Seed <- Seeds],
@@ -5845,7 +5825,7 @@ run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) ->
worker({ProcN,Seed}, InitF, ExecF, FiniF, Laps, Parent, NumOfProcs) ->
io:format("smp worker ~p, seed=~p~n",[self(),Seed]),
- random:seed(Seed,Seed,Seed),
+ rand:seed(exsplus, {Seed,Seed,Seed}),
State1 = InitF([ProcN, NumOfProcs]),
State2 = worker_loop(Laps, ExecF, State1),
Result = FiniF(State2),
diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl
index c6f24fc670..5c2ab4747c 100644
--- a/lib/stdlib/test/ets_tough_SUITE.erl
+++ b/lib/stdlib/test/ets_tough_SUITE.erl
@@ -23,7 +23,7 @@
-export([init/1,terminate/2,handle_call/3,handle_info/2]).
-export([init_per_testcase/2, end_per_testcase/2]).
-compile([export_all]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -92,7 +92,7 @@ ex1_sub(Config) ->
ok.
prep(Config) ->
- random:seed(),
+ rand:seed(exsplus),
put(dump_ticket,none),
DumpDir = filename:join(?config(priv_dir,Config), "ets_tough"),
file:make_dir(DumpDir),
@@ -221,19 +221,19 @@ random_class() ->
random_element(Classes).
random_key() ->
- random:uniform(8).
+ rand:uniform(8).
random_value() ->
- case random:uniform(5) of
+ case rand:uniform(5) of
1 -> ok;
2 -> {data,random_key()};
3 -> {foo,bar,random_class()};
- 4 -> random:uniform(1000);
+ 4 -> rand:uniform(1000);
5 -> {recursive,random_value()}
end.
random_element(T) ->
- I = random:uniform(tuple_size(T)),
+ I = rand:uniform(tuple_size(T)),
element(I,T).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/stdlib/test/file_sorter_SUITE.erl b/lib/stdlib/test/file_sorter_SUITE.erl
index e0d9ec1fd7..947dc2ad8d 100644
--- a/lib/stdlib/test/file_sorter_SUITE.erl
+++ b/lib/stdlib/test/file_sorter_SUITE.erl
@@ -28,7 +28,7 @@
-define(t,test_server).
-define(privdir(_), "./file_sorter_SUITE_priv").
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), ok).
-define(privdir(Conf), ?config(priv_dir, Conf)).
-endif.
diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl
index 01b798faef..5d5434c7b2 100644
--- a/lib/stdlib/test/filelib_SUITE.erl
+++ b/lib/stdlib/test/filelib_SUITE.erl
@@ -29,7 +29,7 @@
-import(lists, [foreach/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
init_per_testcase(_Case, Config) ->
@@ -318,7 +318,7 @@ same_lists(Expected0, Actual0, BaseDir) ->
mkfiles([H|T], Dir) ->
Name = filename:join(Dir, H),
- Garbage = [31+random:uniform(95) || _ <- lists:seq(1, random:uniform(1024))],
+ Garbage = [31+rand:uniform(95) || _ <- lists:seq(1, rand:uniform(1024))],
file:write_file(Name, Garbage),
[Name|mkfiles(T, Dir)];
mkfiles([], _) -> [].
diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl
index fd47da8150..8ecbc7eadf 100644
--- a/lib/stdlib/test/filename_SUITE.erl
+++ b/lib/stdlib/test/filename_SUITE.erl
@@ -29,7 +29,7 @@
dirname_bin/1, extension_bin/1, join_bin/1, t_nativename_bin/1]).
-export([pathtype_bin/1,rootname_bin/1,split_bin/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -97,20 +97,11 @@ absname(Config) when is_list(Config) ->
?line file:set_cwd(Cwd),
ok;
- Type ->
- case Type of
- {unix, _} ->
- ?line ok = file:set_cwd("/usr"),
- ?line "/usr/foo" = filename:absname(foo),
- ?line "/usr/foo" = filename:absname("foo"),
- ?line "/usr/../ebin" = filename:absname("../ebin");
- {ose, _} ->
- ?line ok = file:set_cwd("/romfs"),
- ?line "/romfs/foo" = filename:absname(foo),
- ?line "/romfs/foo" = filename:absname("foo"),
- ?line "/romfs/../ebin" = filename:absname("../ebin")
- end,
-
+ {unix, _} ->
+ ?line ok = file:set_cwd("/usr"),
+ ?line "/usr/foo" = filename:absname(foo),
+ ?line "/usr/foo" = filename:absname("foo"),
+ ?line "/usr/../ebin" = filename:absname("../ebin"),
?line file:set_cwd("/"),
?line "/foo" = filename:absname(foo),
?line "/foo" = filename:absname("foo"),
@@ -494,18 +485,10 @@ absname_bin(Config) when is_list(Config) ->
?line file:set_cwd(Cwd),
ok;
- Type ->
- case Type of
- {unix,_} ->
- ?line ok = file:set_cwd(<<"/usr">>),
- ?line <<"/usr/foo">> = filename:absname(<<"foo">>),
- ?line <<"/usr/../ebin">> = filename:absname(<<"../ebin">>);
- {ose,_} ->
- ?line ok = file:set_cwd(<<"/romfs">>),
- ?line <<"/romfs/foo">> = filename:absname(<<"foo">>),
- ?line <<"/romfs/../ebin">> = filename:absname(<<"../ebin">>)
- end,
-
+ {unix, _} ->
+ ?line ok = file:set_cwd(<<"/usr">>),
+ ?line <<"/usr/foo">> = filename:absname(<<"foo">>),
+ ?line <<"/usr/../ebin">> = filename:absname(<<"../ebin">>),
?line file:set_cwd(<<"/">>),
?line <<"/foo">> = filename:absname(<<"foo">>),
?line <<"/../ebin">> = filename:absname(<<"../ebin">>),
diff --git a/lib/stdlib/test/fixtable_SUITE.erl b/lib/stdlib/test/fixtable_SUITE.erl
index cf716032a1..66150e60c1 100644
--- a/lib/stdlib/test/fixtable_SUITE.erl
+++ b/lib/stdlib/test/fixtable_SUITE.erl
@@ -56,7 +56,7 @@ end_per_group(_GroupName, Config) ->
Config.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%% I wrote this thinking I would use more than one temporary at a time, but
%%% I wasn't... Well, maybe in the future...
diff --git a/lib/stdlib/test/format_SUITE.erl b/lib/stdlib/test/format_SUITE.erl
index 77636687cd..da28e085bb 100644
--- a/lib/stdlib/test/format_SUITE.erl
+++ b/lib/stdlib/test/format_SUITE.erl
@@ -25,7 +25,7 @@
-export([init_per_testcase/2, end_per_testcase/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl
index b019f98b69..e14f057720 100644
--- a/lib/stdlib/test/gen_event_SUITE.erl
+++ b/lib/stdlib/test/gen_event_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(gen_event_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]).
diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl
index e3da1a2271..c238232ef0 100644
--- a/lib/stdlib/test/gen_fsm_SUITE.erl
+++ b/lib/stdlib/test/gen_fsm_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(gen_fsm_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test cases
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index 0ae763a48d..634d868ad4 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(gen_server_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/inet.hrl").
-export([init_per_testcase/2, end_per_testcase/2]).
diff --git a/lib/stdlib/test/id_transform_SUITE.erl b/lib/stdlib/test/id_transform_SUITE.erl
index 1cff990697..a0c3c9317a 100644
--- a/lib/stdlib/test/id_transform_SUITE.erl
+++ b/lib/stdlib/test/id_transform_SUITE.erl
@@ -31,7 +31,7 @@
% Serves as test...
-hej(hopp).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 0e897631ff..821673559b 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -46,7 +46,7 @@
-define(t, test_server).
-define(privdir(_), "./io_SUITE_priv").
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), ok).
-define(privdir(Conf), ?config(priv_dir, Conf)).
-endif.
diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl
index 811c7ed7bb..97e6a90b76 100644
--- a/lib/stdlib/test/io_proto_SUITE.erl
+++ b/lib/stdlib/test/io_proto_SUITE.erl
@@ -47,7 +47,7 @@
-define(t, test_server).
-define(privdir(_), "./io_SUITE_priv").
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(privdir(Conf), ?config(priv_dir, Conf)).
-endif.
diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl
index a0f7fd2744..257607f734 100644
--- a/lib/stdlib/test/lists_SUITE.erl
+++ b/lib/stdlib/test/lists_SUITE.erl
@@ -22,7 +22,7 @@
%%%-----------------------------------------------------------------
-module(lists_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% Default timetrap timeout (set in init_per_testcase).
@@ -1677,8 +1677,7 @@ check_stab(L, U, S, US, SS) ->
%%% Element 3 in the tuple is the position of the tuple in the list.
biglist(N) ->
- {A, B, C} = get_seed(),
- random:seed(A, B, C),
+ rand:seed(exsplus),
biglist(N, []).
biglist(0, L) ->
@@ -1694,8 +1693,7 @@ biglist(N, L) ->
%%% No sequence number.
ubiglist(N) ->
- {A, B, C} = get_seed(),
- random:seed(A, B, C),
+ rand:seed(exsplus),
ubiglist(N, []).
ubiglist(0, L) ->
@@ -1719,8 +1717,7 @@ urandom_tuple(N, I) ->
%%% sequence number.
bigfunlist(N) ->
- {A, B, C} = get_seed(),
- random:seed(A, B, C),
+ rand:seed(exsplus),
bigfunlist_1(N).
bigfunlist_1(N) when N < 30000 -> % Now (R8) max 32000 different pids.
@@ -1754,21 +1751,13 @@ make_fun(Pid) ->
fun_pid(Fun) ->
erlang:fun_info(Fun, pid).
-get_seed() ->
- case random:seed() of
- undefined ->
- erlang:timestamp();
- Tuple ->
- Tuple
- end.
-
random_tuple(N, Seq) ->
R1 = randint(N),
R2 = randint(N),
{R1, R2, Seq}.
randint(N) ->
- trunc(random:uniform() * N).
+ trunc(rand:uniform() * N).
%% The first "duplicate" is kept.
no_dups([]) ->
@@ -1830,8 +1819,7 @@ sort_loop_1(Pid) ->
end.
sloop(N) ->
- {A, B, C} = get_seed(),
- random:seed(A, B, C),
+ rand:seed(exsplus),
sloop(N, #state{}).
sloop(N, S) ->
diff --git a/lib/stdlib/test/log_mf_h_SUITE.erl b/lib/stdlib/test/log_mf_h_SUITE.erl
index 86af3d4614..70d03dd46f 100644
--- a/lib/stdlib/test/log_mf_h_SUITE.erl
+++ b/lib/stdlib/test/log_mf_h_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(log_mf_h_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl
index 40a8b6ac81..f1f476433b 100644
--- a/lib/stdlib/test/maps_SUITE.erl
+++ b/lib/stdlib/test/maps_SUITE.erl
@@ -23,7 +23,7 @@
-module(maps_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl
index f02e82b39c..6a9478d0d2 100644
--- a/lib/stdlib/test/ms_transform_SUITE.erl
+++ b/lib/stdlib/test/ms_transform_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2003-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.
@@ -20,7 +20,7 @@
-module(ms_transform_SUITE).
-author('[email protected]').
--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]).
@@ -342,8 +342,8 @@ records(doc) ->
records(Config) when is_list(Config) ->
?line setup(Config),
?line RD = <<"-record(t, {"
- "t1 = [],"
- "t2 = foo,"
+ "t1 = [] :: list(),"
+ "t2 = foo :: atom(),"
"t3,"
"t4"
"}).">>,
diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl
index f7a6a38138..a39a82b0df 100644
--- a/lib/stdlib/test/proc_lib_SUITE.erl
+++ b/lib/stdlib/test/proc_lib_SUITE.erl
@@ -44,7 +44,7 @@
-ifdef(STANDALONE).
-define(line, noop, ).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-endif.
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 52fdb69b73..6f94e740eb 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -43,7 +43,7 @@
-define(testcase, current_testcase). % don't know
-define(t, test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(datadir, ?config(data_dir, Config)).
-define(privdir, ?config(priv_dir, Config)).
-define(testcase, ?config(?TESTCASE, Config)).
diff --git a/lib/stdlib/test/queue_SUITE.erl b/lib/stdlib/test/queue_SUITE.erl
index c965a8b218..77fe6adb7c 100644
--- a/lib/stdlib/test/queue_SUITE.erl
+++ b/lib/stdlib/test/queue_SUITE.erl
@@ -25,7 +25,7 @@
-export([init_per_testcase/2, end_per_testcase/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
@@ -470,7 +470,7 @@ oops(suite) ->
oops(Config) when is_list(Config) ->
?line N = 3142,
?line Optab = optab(),
- ?line Seed0 = random:seed0(),
+ ?line Seed0 = rand:seed(exsplus, {1,2,4}),
?line {Is,Seed} = random_list(N, tuple_size(Optab), Seed0, []),
?line io:format("~p ", [Is]),
?line QA = queue:new(),
@@ -562,20 +562,20 @@ args([], _, Seed, R) ->
args([q|Ts], [Q|Qs]=Qss, Seed, R) ->
args(Ts, if Qs =:= [] -> Qss; true -> Qs end, Seed, [Q|R]);
args([l|Ts], Qs, Seed0, R) ->
- {N,Seed1} = random:uniform_s(17, Seed0),
+ {N,Seed1} = rand:uniform_s(17, Seed0),
{L,Seed} = random_list(N, 4711, Seed1, []),
args(Ts, Qs, Seed, [L|R]);
args([t|Ts], Qs, Seed0, R) ->
- {T,Seed} = random:uniform_s(4711, Seed0),
+ {T,Seed} = rand:uniform_s(4711, Seed0),
args(Ts, Qs, Seed, [T|R]);
args([n|Ts], Qs, Seed0, R) ->
- {N,Seed} = random:uniform_s(17, Seed0),
+ {N,Seed} = rand:uniform_s(17, Seed0),
args(Ts, Qs, Seed, [N|R]).
random_list(0, _, Seed, R) ->
{R,Seed};
random_list(N, M, Seed0, R) ->
- {X,Seed} = random:uniform_s(M, Seed0),
+ {X,Seed} = rand:uniform_s(M, Seed0),
random_list(N-1, M, Seed, [X|R]).
call(Func, As) ->
diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl
index 03b5ce1a25..ab260da950 100644
--- a/lib/stdlib/test/rand_SUITE.erl
+++ b/lib/stdlib/test/rand_SUITE.erl
@@ -33,7 +33,7 @@
-export([test/0, gen/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(3)).
diff --git a/lib/stdlib/test/random_SUITE.erl b/lib/stdlib/test/random_SUITE.erl
index 738f73ae15..701a3e3f33 100644
--- a/lib/stdlib/test/random_SUITE.erl
+++ b/lib/stdlib/test/random_SUITE.erl
@@ -25,7 +25,7 @@
-export([init_per_testcase/2, end_per_testcase/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/stdlib/test/random_iolist.erl b/lib/stdlib/test/random_iolist.erl
index 9a0f034e72..6da7da04de 100644
--- a/lib/stdlib/test/random_iolist.erl
+++ b/lib/stdlib/test/random_iolist.erl
@@ -36,7 +36,7 @@ run2(Iter,Fun1,Fun2) ->
compare2(Iter,Fun1,Fun2).
random_byte() ->
- random:uniform(256) - 1.
+ rand:uniform(256) - 1.
random_list(0,Acc) ->
Acc;
@@ -45,7 +45,7 @@ random_list(N,Acc) ->
random_binary(N) ->
B = list_to_binary(random_list(N,[])),
- case {random:uniform(2),size(B)} of
+ case {rand:uniform(2),size(B)} of
{2,M} when M > 1 ->
S = M-1,
<<_:3,C:S/binary,_:5>> = B,
@@ -57,7 +57,7 @@ random_list(N) ->
random_list(N,[]).
front() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
10 ->
false;
_ ->
@@ -65,7 +65,7 @@ front() ->
end.
any_type() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
1 ->
list;
2 ->
@@ -77,7 +77,7 @@ any_type() ->
end.
tail_type() ->
- case random:uniform(5) of
+ case rand:uniform(5) of
1 ->
list;
2 ->
@@ -90,9 +90,9 @@ random_length(N) ->
UpperLimit = 255,
case N of
M when M > UpperLimit ->
- random:uniform(UpperLimit+1) - 1;
+ rand:uniform(UpperLimit+1) - 1;
_ ->
- random:uniform(N+1) - 1
+ rand:uniform(N+1) - 1
end.
random_iolist(0,Acc) ->
@@ -139,7 +139,7 @@ random_iolist(N) ->
standard_seed() ->
- random:seed(1201,855653,380975).
+ rand:seed(exsplus, {1201,855653,380975}).
do_comp(List,F1,F2) ->
X = F1(List),
diff --git a/lib/stdlib/test/random_unicode_list.erl b/lib/stdlib/test/random_unicode_list.erl
index ecafe42318..3bc86a8430 100644
--- a/lib/stdlib/test/random_unicode_list.erl
+++ b/lib/stdlib/test/random_unicode_list.erl
@@ -85,7 +85,7 @@ int_to_utf32_little(I) ->
id(I) -> I.
random_char() ->
- case random:uniform(16#10FFFF+1) - 1 of
+ case rand:uniform(16#10FFFF+1) - 1 of
X when X >= 16#D800,
X =< 16#DFFF ->
random_char();
@@ -116,13 +116,13 @@ random_binary(N,Enc) ->
int_to(Enc,X)
end,
L)),
- case {random:uniform(3),size(B)} of
+ case {rand:uniform(3),size(B)} of
{2,M} when M > 1 ->
B2 = id(<<1:3,B/binary,1:5>>),
<<_:3,C:M/binary,_:5>> = B2,
C;
{3,M} when M > 1 ->
- X = random:uniform(M+1)-1,
+ X = rand:uniform(M+1)-1,
<<B1:X/binary,B2/binary>> = B,
[B1,B2];
_ ->
@@ -132,7 +132,7 @@ random_list(N) ->
random_list(N,[]).
front() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
10 ->
false;
_ ->
@@ -140,7 +140,7 @@ front() ->
end.
any_type() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
1 ->
list;
2 ->
@@ -152,7 +152,7 @@ any_type() ->
end.
tail_type() ->
- case random:uniform(5) of
+ case rand:uniform(5) of
1 ->
list;
2 ->
@@ -165,9 +165,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_unicode_list(0,Acc,_Enc) ->
@@ -214,7 +214,7 @@ random_unicode_list(N,Enc) ->
standard_seed() ->
- random:seed(1201,855653,380975).
+ rand:seed(exsplus, {1201,855653,380975}).
do_comp(List,F1,F2) ->
X = F1(List),
diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl
index d78d6153da..bd495ce587 100644
--- a/lib/stdlib/test/re_SUITE.erl
+++ b/lib/stdlib/test/re_SUITE.erl
@@ -30,7 +30,7 @@
opt_no_start_optimize/1,opt_never_utf/1,opt_ucp/1,
match_limit/1,sub_binaries/1,copt/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/stdlib/test/run_pcre_tests.erl b/lib/stdlib/test/run_pcre_tests.erl
index 1fdc777470..b7d1df39b8 100644
--- a/lib/stdlib/test/run_pcre_tests.erl
+++ b/lib/stdlib/test/run_pcre_tests.erl
@@ -1083,7 +1083,7 @@ dumponesplit(F,{RE,Line,O,TS}) ->
%% Generate replacement tests from indatafile,
%% you will need perl on the machine
gen_repl_test(OneFile) ->
- random:seed(1219,687731,62804),
+ rand:seed(exsplus, {1219,687731,62804}),
{ok,Bin} = file:read_file(OneFile),
Lines = splitfile(0,Bin,1),
Structured = stru(Lines),
@@ -1237,15 +1237,15 @@ btr(_) ->
ranchar() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
9 -> $&;
10 -> <<"\\1">>;
N when N < 5 ->
- random:uniform($Z-$A)+$A-1;
+ rand:uniform($Z-$A)+$A-1;
M when M < 9 ->
- random:uniform($z-$a)+$a-1
+ rand:uniform($z-$a)+$a-1
end.
ranstring() ->
- iolist_to_binary([ranchar() || _ <- lists:duplicate(random:uniform(20),0) ]).
+ iolist_to_binary([ranchar() || _ <- lists:duplicate(rand:uniform(20),0) ]).
diff --git a/lib/stdlib/test/select_SUITE.erl b/lib/stdlib/test/select_SUITE.erl
index ead64ffc75..f92971583a 100644
--- a/lib/stdlib/test/select_SUITE.erl
+++ b/lib/stdlib/test/select_SUITE.erl
@@ -38,7 +38,7 @@
-export([config/2]).
-define(fmt(A,B),io:format(A,B)).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(fmt(A,B),test_server:format(A,B)).
-endif.
@@ -212,11 +212,10 @@ init_random(Config) ->
{ok,[X]} ->
X;
_ ->
- {A,B,C} = erlang:timestamp(),
- random:seed(A,B,C),
- get(random_seed)
+ rand:seed(exsplus),
+ rand:export_seed()
end,
- put(random_seed,Seed),
+ rand:seed(Seed),
{ok, F} = file:open(filename:join([WriteDir, "last_random_seed2.txt"]),
[write]),
io:format(F,"~p. ~n",[Seed]),
@@ -224,11 +223,11 @@ init_random(Config) ->
ok.
create_random_key(N,Type) ->
- gen_key(random:uniform(N),Type).
+ gen_key(rand:uniform(N),Type).
create_pb_key(N,list) ->
- X = random:uniform(N),
- case random:uniform(4) of
+ X = rand:uniform(N),
+ case rand:uniform(4) of
3 -> {[X, X+1, '_'], fun([Z,Z1,P1]) ->
[Z,Z1,P1] =:= [X,X+1,P1] end};
2 -> {[X, '_', '_'], fun([Z,P1,P2]) -> [Z,P1,P2] =:= [X,P1,P2] end};
@@ -237,14 +236,14 @@ create_pb_key(N,list) ->
_ -> {[X, '$1', '$2'], fun([Z,P1,P2]) -> [Z,P1,P2] =:= [X,P1,P2] end}
end;
create_pb_key(N, tuple) ->
- X = random:uniform(N),
- case random:uniform(2) of
+ X = rand:uniform(N),
+ case rand:uniform(2) of
1 -> {{X, X+1, '$1'},fun({Z,Z1,P1}) -> {Z,Z1,P1} =:= {X,X+1,P1} end};
_ -> {{X, '$1', '$2'},fun({Z,P1,P2}) -> {Z,P1,P2} =:= {X,P1,P2} end}
end;
create_pb_key(N, complex) ->
- X = random:uniform(N),
- case random:uniform(2) of
+ X = rand:uniform(N),
+ case rand:uniform(2) of
1 -> {{[X, X+1], '$1'}, fun({[Z,Z1],P1}) ->
{[Z,Z1],P1} =:= {[X,X+1],P1} end};
_ -> {{[X, '$1'], '$2'},fun({[Z,P1],P2}) ->
diff --git a/lib/stdlib/test/sets_SUITE.erl b/lib/stdlib/test/sets_SUITE.erl
index 972a812072..06da696700 100644
--- a/lib/stdlib/test/sets_SUITE.erl
+++ b/lib/stdlib/test/sets_SUITE.erl
@@ -31,7 +31,7 @@
is_set/1,fold/1,filter/1,
take_smallest/1,take_largest/1, iterate/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-import(lists, [foldl/3,reverse/1]).
@@ -107,9 +107,9 @@ add_element_del([H|T], M, S, Del, []) ->
add_element_del(T, M, M(add_element, {H,S}), Del, [H]);
add_element_del([H|T], M, S0, Del, Inserted) ->
S1 = M(add_element, {H,S0}),
- case random:uniform(3) of
+ case rand:uniform(3) of
1 ->
- OldEl = lists:nth(random:uniform(length(Inserted)), Inserted),
+ OldEl = lists:nth(rand:uniform(length(Inserted)), Inserted),
S = M(del_element, {OldEl,S1}),
add_element_del(T, M, S, [OldEl|Del], [H|Inserted]);
_ ->
@@ -438,7 +438,7 @@ iterate_1(M) ->
M(empty, []).
iterate_2(M) ->
- random:seed(1, 2, 42),
+ rand:seed(exsplus, {1,2,42}),
iter_set(M, 1000).
iter_set(_M, 0) ->
@@ -447,7 +447,7 @@ iter_set(M, N) ->
L = [I || I <- lists:seq(1, N)],
T = M(from_list, L),
L = lists:reverse(iterate_set(M, T)),
- R = random:uniform(N),
+ R = rand:uniform(N),
S = lists:reverse(iterate_set(M, R, T)),
S = [E || E <- L, E >= R],
iter_set(M, N-1).
@@ -481,7 +481,7 @@ sets_mods() ->
test_all(Tester) ->
Res = [begin
- random:seed(1, 2, 42),
+ rand:seed(exsplus, {1,2,42}),
S = Tester(M),
{M(size, S),lists:sort(M(to_list, S))}
end || M <- sets_mods()],
@@ -492,7 +492,7 @@ test_all([{Low,High}|T], Tester) ->
test_all([Sz|T], Tester) when is_integer(Sz) ->
List = rnd_list(Sz),
Res = [begin
- random:seed(19, 2, Sz),
+ rand:seed(exsplus, {19,2,Sz}),
S = Tester(List, M),
{M(size, S),lists:sort(M(to_list, S))}
end || M <- sets_mods()],
@@ -512,10 +512,10 @@ rnd_list(Sz) ->
rnd_list_1(Sz, []).
atomic_rnd_term() ->
- case random:uniform(3) of
- 1 -> list_to_atom(integer_to_list($\s+random:uniform(94))++"rnd");
- 2 -> random:uniform();
- 3 -> random:uniform(50)-37
+ case rand:uniform(3) of
+ 1 -> list_to_atom(integer_to_list($\s+rand:uniform(94))++"rnd");
+ 2 -> rand:uniform();
+ 3 -> rand:uniform(50)-37
end.
rnd_list_1(0, Acc) -> Acc;
@@ -543,7 +543,7 @@ remove_some(List0, P) ->
end.
remove_some([H|T], P, Acc) ->
- case random:uniform() of
+ case rand:uniform() of
F when F < P -> %Remove.
remove_some(T, P, Acc);
_ ->
diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl
index a9dd6b5817..747b76abb6 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -52,7 +52,7 @@
config(priv_dir,_) ->
".".
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init_per_testcase/2, end_per_testcase/2]).
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(10)).
@@ -393,7 +393,9 @@ records(Config) when is_list(Config) ->
Test = filename:join(?config(priv_dir, Config), "test.erl"),
Contents = <<"-module(test).
- -record(state, {bin, reply, leader}).
+ -record(state, {bin :: binary(),
+ reply = no,
+ leader = some :: atom()}).
-ifdef(test1).
-record(test1, {f}).
diff --git a/lib/stdlib/test/slave_SUITE.erl b/lib/stdlib/test/slave_SUITE.erl
index 65627b3741..f01bf77550 100644
--- a/lib/stdlib/test/slave_SUITE.erl
+++ b/lib/stdlib/test/slave_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(slave_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_start/1, t_start_link/1,
diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl
index d23eb3abb9..9eed2893d4 100644
--- a/lib/stdlib/test/sofs_SUITE.erl
+++ b/lib/stdlib/test/sofs_SUITE.erl
@@ -27,7 +27,7 @@
-define(config(X,Y), foo).
-define(t, test_server).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), ok).
-endif.
diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl
index a586729b30..687e2fb6e8 100644
--- a/lib/stdlib/test/stdlib_SUITE.erl
+++ b/lib/stdlib/test/stdlib_SUITE.erl
@@ -21,7 +21,7 @@
%%% Purpose:Stdlib application test suite.
%%%-----------------------------------------------------------------
-module(stdlib_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-compile(export_all).
diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl
index 53eea6f180..6ac3950f44 100644
--- a/lib/stdlib/test/string_SUITE.erl
+++ b/lib/stdlib/test/string_SUITE.erl
@@ -21,7 +21,7 @@
%%% Purpose: string test suite.
%%%-----------------------------------------------------------------
-module(string_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% Default timetrap timeout (set in init_per_testcase).
diff --git a/lib/stdlib/test/supervisor_bridge_SUITE.erl b/lib/stdlib/test/supervisor_bridge_SUITE.erl
index b55fbfaf0d..94e719bea1 100644
--- a/lib/stdlib/test/supervisor_bridge_SUITE.erl
+++ b/lib/stdlib/test/supervisor_bridge_SUITE.erl
@@ -24,7 +24,7 @@
simple_global_supervisor/1]).
-export([client/1,init/1,internal_loop_init/1,terminate/2,server9212/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(bridge_name,supervisor_bridge_SUITE_server).
-define(work_bridge_name,work_supervisor_bridge_SUITE_server).
diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl
index 573fa6f358..102a147fcd 100644
--- a/lib/stdlib/test/sys_SUITE.erl
+++ b/lib/stdlib/test/sys_SUITE.erl
@@ -22,7 +22,7 @@
init_per_group/2,end_per_group/2,log/1,log_to_file/1,
stats/1,trace/1,suspend/1,install/1,special_process/1]).
-export([handle_call/3,terminate/2,init/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(server,sys_SUITE_server).
diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl
index 6da017f818..a22eaa1d3a 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -26,7 +26,7 @@
extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1,
memory/1,unicode/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/stdlib/test/timer_SUITE.erl b/lib/stdlib/test/timer_SUITE.erl
index 057d82fb65..e4d656c9bf 100644
--- a/lib/stdlib/test/timer_SUITE.erl
+++ b/lib/stdlib/test/timer_SUITE.erl
@@ -24,7 +24,7 @@
-export([big_test/1, collect/3, i_t/3, a_t/2]).
-export([do_nrev/1, internal_watchdog/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Random test of the timer module. This is a really nasty test, as it
%% runs a lot of timeouts and then checks in the end if any of them
@@ -80,8 +80,6 @@ report_result(Error) -> ?line test_server:fail(Error).
big_test(N) ->
C = start_collect(),
system_time(), system_time(), system_time(),
- random:seed(erlang:timestamp()),
- random:uniform(100),random:uniform(100),random:uniform(100),
big_loop(C, N, []),
@@ -127,17 +125,17 @@ big_loop(C, N, Pids) ->
after 0 ->
%% maybe start an interval timer test
- Pids1 = maybe_start_i_test(Pids, C, random:uniform(4)),
+ Pids1 = maybe_start_i_test(Pids, C, rand:uniform(4)),
%% start 1-4 "after" tests
- Pids2 = start_after_test(Pids1, C, random:uniform(4)),
+ Pids2 = start_after_test(Pids1, C, rand:uniform(4)),
%%Pids2=Pids1,
%% wait a little while
- timer:sleep(random:uniform(200)*3),
+ timer:sleep(rand:uniform(200)*3),
%% spawn zero, one or two nrev to get some load ;-/
- Pids3 = start_nrev(Pids2, random:uniform(100)),
+ Pids3 = start_nrev(Pids2, rand:uniform(100)),
big_loop(C, N-1, Pids3)
end.
@@ -148,20 +146,20 @@ start_nrev(Pids, N) when N < 25 ->
start_nrev(Pids, N) when N < 75 ->
[spawn_link(timer_SUITE, do_nrev, [1])|Pids];
start_nrev(Pids, _N) ->
- NrevPid1 = spawn_link(timer_SUITE, do_nrev, [random:uniform(1000)*10]),
+ NrevPid1 = spawn_link(timer_SUITE, do_nrev, [rand:uniform(1000)*10]),
NrevPid2 = spawn_link(timer_SUITE, do_nrev, [1]),
[NrevPid1,NrevPid2|Pids].
start_after_test(Pids, C, 1) ->
- TO1 = random:uniform(100)*47,
+ TO1 = rand:uniform(100)*47,
[s_a_t(C, TO1)|Pids];
start_after_test(Pids, C, 2) ->
- TO1 = random:uniform(100)*47,
- TO2 = TO1 div random:uniform(3) + 101,
+ TO1 = rand:uniform(100)*47,
+ TO2 = TO1 div rand:uniform(3) + 101,
[s_a_t(C, TO1),s_a_t(C, TO2)|Pids];
start_after_test(Pids, C, N) ->
- TO1 = random:uniform(100)*47,
+ TO1 = rand:uniform(100)*47,
start_after_test([s_a_t(C, TO1)|Pids], C, N-1).
s_a_t(C, TimeOut) ->
@@ -187,8 +185,8 @@ a_t(C, TimeOut) ->
maybe_start_i_test(Pids, C, 1) ->
%% ok do it
- TOI = random:uniform(53)*49,
- CountI = random:uniform(10) + 3, % at least 4 times
+ TOI = rand:uniform(53)*49,
+ CountI = rand:uniform(10) + 3, % at least 4 times
[spawn_link(timer_SUITE, i_t, [C, TOI, CountI])|Pids];
maybe_start_i_test(Pids, _C, _) ->
Pids.
diff --git a/lib/stdlib/test/timer_simple_SUITE.erl b/lib/stdlib/test/timer_simple_SUITE.erl
index 93fbc3a032..42b96c4b1c 100644
--- a/lib/stdlib/test/timer_simple_SUITE.erl
+++ b/lib/stdlib/test/timer_simple_SUITE.erl
@@ -51,7 +51,7 @@
timer/4,
timer/5]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(MAXREF, (1 bsl 18)).
-define(REFMARG, 30).
diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl
index 8bb2555213..f45e00928e 100644
--- a/lib/stdlib/test/unicode_SUITE.erl
+++ b/lib/stdlib/test/unicode_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(unicode_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,
diff --git a/lib/stdlib/test/win32reg_SUITE.erl b/lib/stdlib/test/win32reg_SUITE.erl
index 82baa43318..982cc86979 100644
--- a/lib/stdlib/test/win32reg_SUITE.erl
+++ b/lib/stdlib/test/win32reg_SUITE.erl
@@ -22,7 +22,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,long/1,evil_write/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/stdlib/test/y2k_SUITE.erl b/lib/stdlib/test/y2k_SUITE.erl
index 9e766e80ab..d80dd10631 100644
--- a/lib/stdlib/test/y2k_SUITE.erl
+++ b/lib/stdlib/test/y2k_SUITE.erl
@@ -22,7 +22,7 @@
-module(y2k_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,
diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index c275053691..135bfd5867 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -28,8 +28,7 @@
compress_control/1,
foldl/1]).
--include_lib("test_server/include/test_server.hrl").
--include("test_server_line.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
-include_lib("stdlib/include/zip.hrl").
diff --git a/lib/syntax_tools/src/erl_recomment.erl b/lib/syntax_tools/src/erl_recomment.erl
index 72e1e2d2f5..5ce533285d 100644
--- a/lib/syntax_tools/src/erl_recomment.erl
+++ b/lib/syntax_tools/src/erl_recomment.erl
@@ -611,12 +611,15 @@ expand_comment(C) ->
attrs :: erl_syntax:syntaxTreeAttributes(),
precomments = [] :: [erl_syntax:syntaxTree()],
postcomments = [] :: [erl_syntax:syntaxTree()],
- subtrees = [] :: [erl_syntax:syntaxTree()]}).
+ subtrees = [] :: [extendedSyntaxTree()]}).
+
-record(list, {min = 0 :: integer(),
max = 0 :: integer(),
subtrees = [] :: [erl_syntax:syntaxTree()]}).
+-type extendedSyntaxTree() :: #tree{} | #leaf{} | #list{}.
+
leaf_node(Min, Max, Value) ->
#leaf{min = Min,
max = Max,
diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl
index 3f2a3e05dd..97b5797b06 100644
--- a/lib/syntax_tools/src/erl_syntax.erl
+++ b/lib/syntax_tools/src/erl_syntax.erl
@@ -355,7 +355,7 @@
%% where `Pos' `Ann' and `Comments' are the corresponding values of a
%% `tree' or `wrapper' record.
--record(attr, {pos = 0 :: term(),
+-record(attr, {pos = erl_anno:new(0) :: term(),
ann = [] :: [term()],
com = none :: 'none' | #com{}}).
-type syntaxTreeAttributes() :: #attr{}.
diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl
index 5b5b18d15b..58c4cc5244 100644
--- a/lib/syntax_tools/src/erl_syntax_lib.erl
+++ b/lib/syntax_tools/src/erl_syntax_lib.erl
@@ -359,9 +359,9 @@ new_variable_name(S) ->
%% within a reasonably small range relative to the number of elements in
%% the set.
%%
-%% This function uses the module `random' to generate new
+%% This function uses the module `rand' to generate new
%% keys. The seed it uses may be initialized by calling
-%% `random:seed/0' or `random:seed/3' before this
+%% `rand:seed/1' or `rand:seed/2' before this
%% function is first called.
%%
%% @see new_variable_name/1
@@ -404,7 +404,13 @@ start_range(S) ->
%% order, but (pseudo-)randomly distributed over the range.
generate(_Key, Range) ->
- random:uniform(Range). % works well
+ _ = case rand:export_seed() of
+ undefined ->
+ rand:seed(exsplus, {753,8,73});
+ _ ->
+ ok
+ end,
+ rand:uniform(Range). % works well
%% =====================================================================
diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl
index db7f0939a3..f2de12b410 100644
--- a/lib/syntax_tools/src/erl_tidy.erl
+++ b/lib/syntax_tools/src/erl_tidy.erl
@@ -937,7 +937,7 @@ hidden_uses_2(Tree, Used) ->
-record(env, {file :: file:filename(),
module :: atom(),
- current :: fa(),
+ current :: fa() | 'undefined',
imports = dict:new() :: dict:dict(atom(), atom()),
context = normal :: context(),
verbosity = 1 :: 0 | 1 | 2,
@@ -949,10 +949,10 @@ hidden_uses_2(Tree, Used) ->
new_guard_tests = true :: boolean(),
old_guard_tests = false :: boolean()}).
--record(st, {varc :: non_neg_integer(),
+-record(st, {varc :: non_neg_integer() | 'undefined',
used = sets:new() :: sets:set({atom(), arity()}),
imported :: sets:set({atom(), arity()}),
- vars :: sets:set(atom()),
+ vars :: sets:set(atom()) | 'undefined',
functions :: sets:set({atom(), arity()}),
new_forms = [] :: [erl_syntax:syntaxTree()],
rename :: dict:dict(mfa(), {atom(), atom()})}).
@@ -1064,13 +1064,13 @@ visit_clause(Tree, Env, St0) ->
visit_infix_expr(Tree, #env{context = guard_test}, St0) ->
%% Detect transition from guard test to guard expression.
- visit_other(Tree, #env{context = guard_expr}, St0);
+ visit_other(Tree, #env{context = guard_expr, file = ""}, St0);
visit_infix_expr(Tree, Env, St0) ->
visit_other(Tree, Env, St0).
visit_prefix_expr(Tree, #env{context = guard_test}, St0) ->
%% Detect transition from guard test to guard expression.
- visit_other(Tree, #env{context = guard_expr}, St0);
+ visit_other(Tree, #env{context = guard_expr, file = ""}, St0);
visit_prefix_expr(Tree, Env, St0) ->
visit_other(Tree, Env, St0).
diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl
index eac5af5540..4557678f9d 100644
--- a/lib/syntax_tools/src/igor.erl
+++ b/lib/syntax_tools/src/igor.erl
@@ -1594,10 +1594,11 @@ alias_expansions_2(Modules, Table) ->
preserved :: boolean(),
no_headers :: boolean(),
notes :: notes(),
- map :: map_fun(),
+ map :: map_fun() | 'undefined',
renaming :: fun((atom()) -> map_fun()),
expand :: dict:dict({atom(), integer()},
- {atom(), {atom(), integer()}}),
+ {atom(), {atom(), integer()}})
+ | 'undefined',
redirect :: dict:dict(atom(), atom())
}).
diff --git a/lib/syntax_tools/src/merl.erl b/lib/syntax_tools/src/merl.erl
index 690306c17b..163ce48bbc 100644
--- a/lib/syntax_tools/src/merl.erl
+++ b/lib/syntax_tools/src/merl.erl
@@ -514,15 +514,17 @@ parse_forms([]) ->
parse_2(Ts) ->
%% one or more comma-separated expressions?
%% (recall that Ts has no dot tokens if we get to this stage)
- case erl_parse:parse_exprs(Ts ++ [{dot,0}]) of
+ A = a0(),
+ case erl_parse:parse_exprs(Ts ++ [{dot,A}]) of
{ok, Exprs} -> Exprs;
{error, E} ->
- parse_3(Ts ++ [{'end',0}, {dot,0}], [E])
+ parse_3(Ts ++ [{'end',A}, {dot,A}], [E])
end.
parse_3(Ts, Es) ->
%% try-clause or clauses?
- case erl_parse:parse_exprs([{'try',0}, {atom,0,true}, {'catch',0} | Ts]) of
+ A = a0(),
+ case erl_parse:parse_exprs([{'try',A}, {atom,A,true}, {'catch',A} | Ts]) of
{ok, [{'try',_,_,_,_,_}=X]} ->
%% get the right kind of qualifiers in the clause patterns
erl_syntax:try_expr_handlers(X);
@@ -533,7 +535,8 @@ parse_3(Ts, Es) ->
parse_4(Ts, Es) ->
%% fun-clause or clauses? (`(a)' is also a pattern, but `(a,b)' isn't,
%% so fun-clauses must be tried before normal case-clauses
- case erl_parse:parse_exprs([{'fun',0} | Ts]) of
+ A = a0(),
+ case erl_parse:parse_exprs([{'fun',A} | Ts]) of
{ok, [{'fun',_,{clauses,Cs}}]} -> Cs;
{error, E} ->
parse_5(Ts, [E|Es])
@@ -541,7 +544,8 @@ parse_4(Ts, Es) ->
parse_5(Ts, Es) ->
%% case-clause or clauses?
- case erl_parse:parse_exprs([{'case',0}, {atom,0,true}, {'of',0} | Ts]) of
+ A = a0(),
+ case erl_parse:parse_exprs([{'case',A}, {atom,A,true}, {'of',A} | Ts]) of
{ok, [{'case',_,_,Cs}]} -> Cs;
{error, E} ->
%% select the best error to report
@@ -1210,7 +1214,7 @@ merge_comments(StartLine, Cs, [], Acc) ->
merge_comments(StartLine, [], [],
[erl_syntax:set_pos(
erl_syntax:comment(Indent, Text),
- StartLine + Line - 1)
+ anno(StartLine + Line - 1))
|| {Line, _, Indent, Text} <- Cs] ++ Acc);
merge_comments(StartLine, [C|Cs], [T|Ts], Acc) ->
{Line, _Col, Indent, Text} = C,
@@ -1228,3 +1232,9 @@ merge_comments(StartLine, [C|Cs], [T|Ts], Acc) ->
[erl_syntax:comment(Indent, Text)], T),
merge_comments(StartLine, Cs, [Tc|Ts], Acc)
end.
+
+a0() ->
+ anno(0).
+
+anno(Location) ->
+ erl_anno:new(Location).
diff --git a/lib/syntax_tools/src/merl_transform.erl b/lib/syntax_tools/src/merl_transform.erl
index 66b06c8137..fe58b6a122 100644
--- a/lib/syntax_tools/src/merl_transform.erl
+++ b/lib/syntax_tools/src/merl_transform.erl
@@ -68,8 +68,7 @@ case_guard([{expr,_}, {text,Text}]) ->
erl_syntax:is_literal(Text).
case_body([{expr,Expr}, {text,_Text}], T) ->
- pre_expand_case(Expr, erl_syntax:case_expr_clauses(T),
- erl_syntax:get_pos(T)).
+ pre_expand_case(Expr, erl_syntax:case_expr_clauses(T), get_location(T)).
post(T) ->
merl:switch(
@@ -79,7 +78,7 @@ post(T) ->
lists:all(fun erl_syntax:is_literal/1, [F|As])
end,
fun ([{args, As}, {function, F}]) ->
- Line = erl_syntax:get_pos(F),
+ Line = get_location(F),
[F1|As1] = lists:map(fun erl_syntax:concrete/1, [F|As]),
eval_call(Line, F1, As1, T)
end},
@@ -118,7 +117,7 @@ expand_qquote(_As, T, _StartPos) ->
expand_template(F, [Pattern | Args], T) ->
case erl_syntax:is_literal(Pattern) of
true ->
- Line = erl_syntax:get_pos(Pattern),
+ Line = get_location(Pattern),
As = [erl_syntax:concrete(Pattern)],
merl:qquote(Line, "merl:_@function(_@pattern, _@args)",
[{function, F},
@@ -260,3 +259,12 @@ is_erlang_var([C|_]) when C >= $A, C =< $Z ; C >= $À, C =< $Þ, C /= $× ->
true;
is_erlang_var(_) ->
false.
+
+get_location(T) ->
+ Pos = erl_syntax:get_pos(T),
+ case erl_anno:is_anno(Pos) of
+ true ->
+ erl_anno:location(Pos);
+ false ->
+ Pos
+ end.
diff --git a/lib/syntax_tools/test/Makefile b/lib/syntax_tools/test/Makefile
index 569c044b1a..4ace860223 100644
--- a/lib/syntax_tools/test/Makefile
+++ b/lib/syntax_tools/test/Makefile
@@ -26,7 +26,7 @@ RELSYSDIR = $(RELEASE_PATH)/syntax_tools_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/syntax_tools/test/merl_SUITE.erl b/lib/syntax_tools/test/merl_SUITE.erl
index 125250395a..945972d405 100644
--- a/lib/syntax_tools/test/merl_SUITE.erl
+++ b/lib/syntax_tools/test/merl_SUITE.erl
@@ -16,7 +16,7 @@
%%
-module(merl_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% include the Merl header file
-include_lib("syntax_tools/include/merl.hrl").
diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl
index 40e00e0554..eb52cce6af 100644
--- a/lib/syntax_tools/test/syntax_tools_SUITE.erl
+++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl
@@ -18,7 +18,7 @@
%%
-module(syntax_tools_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/test_server/AUTHORS b/lib/test_server/AUTHORS
deleted file mode 100644
index 3212999174..0000000000
--- a/lib/test_server/AUTHORS
+++ /dev/null
@@ -1,12 +0,0 @@
-Original Authors and Contributors:
-
-Mattias Nilsson
-Bj�rn Gustavsson
-Janne Lindblad
-Patrik Winroth
-Claes Wikstr�m
-Siri Hansen
-Peter Andersson
-
-...and others.
-
diff --git a/lib/test_server/Makefile b/lib/test_server/Makefile
deleted file mode 100644
index 382749d1fc..0000000000
--- a/lib/test_server/Makefile
+++ /dev/null
@@ -1,39 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2009. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-#
-# Macros
-#
-
-SUB_DIRECTORIES = src doc/src
-
-include vsn.mk
-VSN = $(TEST_SERVER_VSN)
-
-SPECIAL_TARGETS =
-
-#
-# Default Subdir Targets
-#
-include $(ERL_TOP)/make/otp_subdir.mk
-
diff --git a/lib/test_server/README b/lib/test_server/README
deleted file mode 100644
index fc71c90ca8..0000000000
--- a/lib/test_server/README
+++ /dev/null
@@ -1,113 +0,0 @@
-===========================================================================
- OTP Test Server
-===========================================================================
-
-To compile the 'test_server' application you need to build and install
-a Erlang/OTP system from source. Get your open source Erlang/OTP from
-http://www.erlang.org/. The resulting "erlc" command must be in the
-search path for commands.
-
-The Erlang test_server application and the example tests are to be
-inserted into an existing source tree for Erlang/OTP.
-
-You don't run the Test Server or the tests from the source tree.
-Instead a test installation area $TESTROOT is used with the resulting
-directory structure
-
- $TESTROOT/test_server
- $TESTROOT/<app1>_test
- $TESTROOT/<app2>_test
- .
- .
-
-For more details see the test_server documentation can be found in the
-"$ERL_TOP/lib/test_server/doc/html" directory.
-
-
-Unpacking the sources
----------------------
-
-Enter your Erlang/OTP source tree and unpack the OTP Test Server and
-optionally the test examples
-
- % cd otp_src_RXX
- % gunzip -c test_server-<VSN>.tar.gz | tar xf -
- % gunzip -c emulator-YYYY-MM-DD.tar.gz | tar xf -
- % gunzip -c stdlib-YYYY-MM-DD.tar.gz | tar xf -
-
-
-How to build and install the OTP Test Server
---------------------------------------------
-
-Set the ERL_TOP variable to the top directory of the source tree
-
- % cd otp_src_RXX
-
- % setenv ERL_TOP `pwd`
- or
- % export ERL_TOP=`pwd`
-
-If not done before you need to run the configure script
-
- % ./configure
-
-Then build and install from the the base directory of the test_server
-application
-
- % cd lib/test_server
- % gmake release_tests TESTROOT=<some dir>
-
-
-How to build and install the example test suites
-------------------------------------------------
-
-If you want to build and install the example test suites
-you build and install from the the test directories
-
- % cd $ERL_TOP/lib/stdlib/test
- % gmake release_tests TESTROOT=<some dir>
-
- % cd $ERL_TOP/erts/emulator/test
- % gmake release_tests TESTROOT=<some dir>
-
-
-How to run OTP test suites
---------------------------
-
-First cd into $TESTROOT/test_server
-
- % cd $TESTROOT/test_server
-
-Install the OTP Test Server framework
-
- % erl
- 1> ts:install().
-
-Check which tests are available
-
- 2> ts:tests().
- [...]
-
-Run the collections of test suites one at the time
-
- 3> ts:run(emulator). (starts a xterm with an Erlang shell)
- 4> ts:run(stdlib). (starts a xterm with an Erlang shell)
-
-or all at once
-
- 5> ts:run(). (the node running the tests will be in the background)
-
-Note that it is normal to see lots of error messages in the Erlang
-shell. The tests will stress the system with lots of invalid input to
-find problems in the error handling.
-
-Also note that a failing test case does not always indicate a bug in
-Erlang/OTP. Differences in the network setup, machine configuration
-etc may cause a test case to fail or time out.
-
-The result of the tests are recorded in the file named "index.html" in
-the "$TESTROOT/test_server" directory. You can follow the progress of
-tests suites not yet completed from "last_test.html".
-
-For more details see the test_server documentation can be found in the
-"$ERL_TOP/lib/test_server/doc/html" directory.
diff --git a/lib/test_server/doc/html/.gitignore b/lib/test_server/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/test_server/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/test_server/doc/man3/.gitignore b/lib/test_server/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/test_server/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/test_server/doc/man6/.gitignore b/lib/test_server/doc/man6/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/test_server/doc/man6/.gitignore
+++ /dev/null
diff --git a/lib/test_server/doc/pdf/.gitignore b/lib/test_server/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/test_server/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/test_server/doc/src/Makefile b/lib/test_server/doc/src/Makefile
deleted file mode 100644
index 8c5418aee5..0000000000
--- a/lib/test_server/doc/src/Makefile
+++ /dev/null
@@ -1,140 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2002-2012. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(TEST_SERVER_VSN)
-APPLICATION=test_server
-
-DOC_EXTRA_FRONT_PAGE_INFO=Important note: \
-The Test Server application is obsolete and will be removed \
-in the next major OTP release
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = \
- test_server_ctrl.xml \
- test_server.xml
-XML_REF3_INTERNAL = \
- ts.xml
-XML_REF6_FILES = test_server_app.xml
-
-XML_PART_FILES = \
- part.xml \
- part_notes.xml \
- part_notes_history.xml
-
-XML_CHAPTER_FILES = \
- basics_chapter.xml \
- run_test_chapter.xml \
- write_test_chapter.xml \
- test_spec_chapter.xml \
- example_chapter.xml \
- write_framework_chapter.xml \
- notes.xml \
- notes_history.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-GIF_FILES =
-
-# ----------------------------------------------------
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-HTML_INTERNAL = $(XML_REF3_INTERNAL:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-
-MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
-MAN3_INTERNAL = $(XML_REF3_INTERNAL:%.xml=$(MAN3DIR)/%.3)
-MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6)
-
-HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
-
-TOP_PDF_FILE = $(PDFDIR)/test_server-$(VSN).pdf
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-XML_FLAGS +=
-DVIPS_FLAGS +=
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-$(HTMLDIR)/%.gif: %.gif
- $(INSTALL_DATA) $< $@
-
-docs: pdf html man
-
-pdf: $(TOP_PDF_FILE)
-
-html: gifs $(HTML_REF_MAN_FILE)
-
-man: $(MAN3_FILES) $(MAN3_INTERNAL) $(MAN6_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-debug opt:
-
-clean clean_docs:
- rm -rf $(HTMLDIR)/*
- rm -f $(MAN3DIR)/*
- rm -f $(MAN6DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_docs_spec: docs
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf"
- $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf"
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/html"
- $(INSTALL_DATA) $(HTMLDIR)/* \
- "$(RELSYSDIR)/doc/html"
- $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3"
- $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3"
- $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6"
- $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6"
-
-release_spec:
-
-release_tests_spec:
diff --git a/lib/test_server/doc/src/basics_chapter.xml b/lib/test_server/doc/src/basics_chapter.xml
deleted file mode 100644
index 9e9f38aab4..0000000000
--- a/lib/test_server/doc/src/basics_chapter.xml
+++ /dev/null
@@ -1,215 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Test Server Basics</title>
- <prepared>Siri Hansen</prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>basics_chapter.xml</file>
- </header>
-
- <section>
- <title>Introduction</title>
- <p><em>Test Server</em> is a portable test tool for automated
- testing of Erlang programs and OTP applications. It provides an
- interface for running test programs directly with Test Server
- as well as an interface for integrating Test Server
- with a framework application. The latter makes it possible to use
- Test Server as the engine of a higher level test tool
- application.</p>
-
- <p>It is strongly recommended that Test Server be used from inside
- a framework application, rather than interfaced directly for
- running test programs. Test Server can be pretty difficult to use
- since it's a very general and quite extensive and complex
- application. Furthermore, the <c>test_server_ctrl</c> functions
- are not meant to be used from within the actual test programs. The
- framework should handle communication with Test Server and deal
- with the more complex aspects of this interaction automatically so
- that a higher level interface may be provided for the tester. For
- test tool usage to be productive, a simpler, more intuitive and
- (if required) more specific interface is required than what Test Server
- can provide.</p>
-
- <p>OTP delivers a general purpose framework for Test Server, called
- <em>Common Test</em>. This application is a tool well suited for
- automated black box testing of target systems of <em>any kind</em>
- (not necessarily implemented in Erlang). Common Test is also a very
- useful tool for white box testing of Erlang programs and OTP
- applications. Unless a more specific functionality and/or user
- interface is required (in which case you might need to implement
- your own framework), Common Test should do the job for
- you. Please read the Common Test User's Guide and reference manual
- for more information.</p>
-
- <p>Under normal circumstances, knowledge about the Test Server
- application is not required for using the Common Test framework.
- However, if you want to use Test Server without a framework,
- or learn how to integrate it with your own framework, please read on...
- </p>
- </section>
- <section>
- <title>Getting started</title>
- <p>Testing when using Test Server is done by running test
- suites. A test suite is a number of test cases, where each test
- case tests one or more things. The test case is the smallest unit
- that the test server deals with. One or more test cases are
- grouped together into one ordinary Erlang module, which is called
- a test suite. Several test suite modules can be grouped together
- in special test specification files representing whole application
- and/or system test "jobs".
- </p>
- <p>The test suite Erlang module must follow a certain interface,
- which is specified by Test Server. See the section on writing
- test suites for details about this.
- </p>
- <p>Each test case is considered a success if it returns to the
- caller, no matter what the returned value is. An exception to this
- is the return value <c>{skip, Reason}</c> which indicates that the
- test case is skipped. A failure is specified as a crash, no matter
- what the crash reason is.
- </p>
- <p>As a test suite runs, all information (including output to
- stdout) is recorded in several different log files. A minimum of
- information is displayed to the user console. This only include
- start and stop information, plus a note for each failed test case.
- </p>
- <p>The result from each test case is recorded in an HTML log file
- which is created for each test run. Every test case gets one row
- in a table presenting total time, whether the case was successful
- or not, if it was skipped, and possibly also a comment. The HTML
- file has links to each test case's logfile, which may be viewed
- from e.g. Netscape or any other HTML capable browser.
- </p>
- <p>The Test Server consists of three parts:
- </p>
- <list type="bulleted">
- <item>The part that executes the test suites and
- provides support for the test suite author is called
- <c>test_server</c>. This is described in the chapter about
- writing test cases in this user's guide, and in the reference
- manual for the <c>test_server</c> module.</item>
- <item>The controlling part, which provides the low level
- operator interface, starts and stops slave nodes and writes
- log files, is called
- <c>test_server_ctrl</c>. The Test Server Controller should not
- be used directly when running tests. Instead a framework built
- on top of it should be used. More information
- about how to write your own framework can be found
- in this user's guide and in the reference manual for the
- <c>test_server_ctrl</c> module.</item>
- </list>
- </section>
-
- <section>
- <title>Definition of terms</title>
- <taglist>
- <tag><em>conf(iguration) case</em></tag>
- <item>This is a group of test cases which need some specific
- configuration. A conf case contains an initiation function which
- sets up a specific configuration, one or more test cases using
- this configuration, and a cleanup function which restores the
- configuration. A conf case is specified in a test specification
- either like this:<c>{conf,InitFunc,ListOfCases,CleanupFunc}</c>,
- or this: <c>{conf,Properties,InitFunc,ListOfCases,CleanupFunc}</c>
- </item>
- <tag><em>datadir</em></tag>
- <item>Data directory for a test suite. This directory contains
- any files used by the test suite, e.g. additional erlang
- modules, c code or data files. If the data directory contains
- code which must be compiled before the test suite is run, it
- should also contain a makefile source called Makefile.src
- defining how to compile.
- </item>
- <tag><em>documentation clause</em></tag>
- <item>One of the function clauses in a test case. This clause
- shall return a list of strings describing what the test case
- tests.
- </item>
- <tag><em>execution clause</em></tag>
- <item>One of the function clauses in a test case. This clause
- implements the actual test case, i.e. calls the functions that
- shall be tested and checks results. The clause shall crash if it
- fails.
- </item>
- <tag><em>major log file</em></tag>
- <item>This is the test suites log file.
- </item>
- <tag><em>Makefile.src</em></tag>
- <item>This file is used by the test server framework to generate
- a makefile for a datadir. It contains some special characters
- which are replaced according to the platform currently tested.
- </item>
- <tag><em>minor log file</em></tag>
- <item>This is a separate log file for each test case.
- </item>
- <tag><em>privdir</em></tag>
- <item>Private directory for a test suite. This directory should
- be used when the test suite needs to write to files.
- </item>
- <tag><em>skip case</em></tag>
- <item>A test case which shall be skipped.
- </item>
- <tag><em>specification clause</em></tag>
- <item>One of the function clauses in a test case. This clause
- shall return an empty list, a test specification or
- <c>{skip,Reason}</c>. If an empty list is returned, it means
- that the test case shall be executed, and so it must also have
- an execution clause.
- </item>
- <tag><em>test case</em></tag>
- <item>A single test included in a test suite. Typically it tests
- one function in a module or application. A test case is
- implemented as a function in a test suite module. The function
- can have three clauses, the documentation-, specification- and
- execution clause.
- </item>
- <tag><em>test specification</em></tag>
- <item>A specification of which test suites and test cases to
- run. There can be test specifications on three different levels
- in a test. The top level is a test specification file which
- roughly specifies what to test for a whole application. Then
- there is a test specification for each test suite returned from
- the <c>all(suite)</c> function in the suite. And there can also
- be a test specification returned from the specification clause
- of a test case.
- </item>
- <tag><em>test specification file</em></tag>
- <item>This is a text file containing the test specification for
- an application. The file has the extension ".spec" or
- ".spec.Platform", where Platform is e.g. "vxworks".
- </item>
- <tag><em>test suite</em></tag>
- <item>An erlang module containing a collection of test cases for
- a specific application or module.
- </item>
- <tag><em>topcase</em></tag>
- <item>The first "command" in a test specification file. This
- command contains the test specification, like this:
- <c>{topcase,TestSpecification}</c></item>
- </taglist>
- </section>
-</chapter>
-
diff --git a/lib/test_server/doc/src/book.xml b/lib/test_server/doc/src/book.xml
deleted file mode 100644
index 6eb7daae1a..0000000000
--- a/lib/test_server/doc/src/book.xml
+++ /dev/null
@@ -1,50 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE book SYSTEM "book.dtd">
-
-<book xmlns:xi="http://www.w3.org/2001/XInclude">
- <header titlestyle="normal">
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Test Server</title>
- <prepared>Siri Hansen</prepared>
- <docno></docno>
- <date>2002-07-11</date>
- <rev></rev>
- <file>book.xml</file>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>Test Server</pagetext>
- <preamble>
- <contents level="2"></contents>
- </preamble>
- <parts lift="no">
- <xi:include href="part.xml"/>
- </parts>
- <applications>
- <xi:include href="ref_man.xml"/>
- </applications>
- <releasenotes>
- <xi:include href="notes.xml"/>
- </releasenotes>
- <listofterms></listofterms>
- <index></index>
-</book>
-
diff --git a/lib/test_server/doc/src/example_chapter.xml b/lib/test_server/doc/src/example_chapter.xml
deleted file mode 100644
index ec152fdd6c..0000000000
--- a/lib/test_server/doc/src/example_chapter.xml
+++ /dev/null
@@ -1,151 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Examples</title>
- <prepared>Siri Hansen</prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>example_chapter.xml</file>
- </header>
-
- <section>
- <title>Test suite</title>
- <code type="none">
--module(my_SUITE).
-
--export([all/1,
- not_started/1, not_started_func1/1, not_started_func2/1,
- start/1, stop/1,
- func1/1, func2/1
- ]).
-
--export([init_per_testcase/2, end_per_testcase/2]).
-
--include("test_server.hrl").
-
--define(default_timeout, ?t:minutes(1)).
-
-init_per_testcase(_Case, Config) ->
- Dog=?t:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-end_per_testcase(_Case, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
- ok.
-
-all(suite) ->
- %% Test specification on test suite level
- [not_started,
- {conf, start, [func1, func2], stop}].
-
-not_started(suite) ->
- %% Test specification on test case level
- [not_started_func1, not_started_func2];
-not_started(doc) ->
- ["Testing all functions when application is not started"].
-%% No execution clause unless the specification clause returns [].
-
-
-not_started_func1(suite) ->
- [];
-not_started_func1(doc) ->
- ["Testing function 1 when application is not started"].
-not_started_func1(Config) when list(Config) ->
- {error, not_started} = myapp:func1(dummy_ref,1),
- {error, not_started} = myapp:func1(dummy_ref,2),
- ok.
-
-not_started_func2(suite) ->
- [];
-not_started_func2(doc) ->
- ["Testing function 2 when application is not started"].
-not_started_func2(Config) when list(Config) ->
- {error, not_started} = myapp:func2(dummy_ref,1),
- {error, not_started} = myapp:func2(dummy_ref,2),
- ok.
-
-
-%% No specification clause needed for an init function in a conf case!!!
-start(doc) ->
- ["Testing start of my application."];
-start(Config) when list(Config) ->
- Ref = myapp:start(),
- case erlang:whereis(my_main_process) of
- Pid when pid(Pid) ->
- [{myapp_ref,Ref}|Config];
- undefined ->
- %% Since this is the init function in a conf case, the rest of the
- %% cases in the conf case will be skipped if this case fails.
- ?t:fail("my_main_process did not start")
- end.
-
-func1(suite) ->
- [];
-func1(doc) ->
- ["Test that func1 returns ok when argument is 1 and error if argument is 2"];
-func1(Config) when list(Config) ->
- Ref = ?config(myapp_ref,Config),
- ok = myapp:func1(Ref,1),
- error = myapp:func1(Ref,2),
- ok.
-
-func2(suite) ->
- [];
-func2(doc) ->
- ["Test that func1 returns ok when argument is 3 and error if argument is 4"];
-func2(Config) when list(Config) ->
- Ref = ?config(myapp_ref,Config),
- ok = myapp:func2(Ref,3),
- error = myapp:func2(Ref,4),
- ok.
-
-%% No specification clause needed for a cleanup function in a conf case!!!
-stop(doc) ->
- ["Testing termination of my application"];
-stop(Config) when list(Config) ->
- Ref = ?config(myapp_ref,Config),
- ok = myapp:stop(Ref),
- case erlang:whereis(my_main_process) of
- undefined ->
- lists:keydelete(myapp_ref,1,Config);
- Pid when pid(Pid) ->
- ?t:fail("my_main_process did not stop")
- end.
- </code>
- </section>
-
- <section>
- <title>Test specification file</title>
- <p><em><c>myapp.spec:</c></em></p>
- <code type="none">
-{topcase, {dir, "../myapp_test"}}. % Test specification on top level </code>
- <p><em><c>myapp.spec.vxworks:</c></em></p>
- <code type="none">
-{topcase, {dir, "../myapp_test"}}. % Test specification on top level
-{skip,{my_SUITE,func2,"Not applicable on VxWorks"}}. </code>
- </section>
-</chapter>
-
-
diff --git a/lib/test_server/doc/src/fascicules.xml b/lib/test_server/doc/src/fascicules.xml
deleted file mode 100644
index 37feca543f..0000000000
--- a/lib/test_server/doc/src/fascicules.xml
+++ /dev/null
@@ -1,18 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE fascicules SYSTEM "fascicules.dtd">
-
-<fascicules>
- <fascicule file="part" href="part_frame.html" entry="no">
- User's Guide
- </fascicule>
- <fascicule file="ref_man" href="ref_man_frame.html" entry="yes">
- Reference Manual
- </fascicule>
- <fascicule file="part_notes" href="part_notes_frame.html" entry="no">
- Release Notes
- </fascicule>
- <fascicule file="" href="../../../../doc/print.html" entry="no">
- Off-Print
- </fascicule>
-</fascicules>
-
diff --git a/lib/test_server/doc/src/notes.xml b/lib/test_server/doc/src/notes.xml
deleted file mode 100644
index b48bda94d0..0000000000
--- a/lib/test_server/doc/src/notes.xml
+++ /dev/null
@@ -1,1694 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2004</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>APPLICATION Release Notes</title>
- <prepared>Peter Andersson</prepared>
- <responsible>Peter Andersson</responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2007-11-30</date>
- <rev>A</rev>
- <file>notes.xml</file>
- </header>
-
-<section><title>Test_Server 3.9.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- When generating Makefile from Makefile.src,
- ts_lib:get_arg/4 earlier removed all spaces in the
- extracted argument. The code was probably meant for
- removing leading and trailing spaces only, and is now
- corrected to do so.</p>
- <p>
- Own Id: OTP-13015</p>
- </item>
- <item>
- <p>
- With the Common Test 'create_priv_dir' start option set
- to 'auto_per_tc', the name of the priv directory for a
- configuration function could clash with the name of the
- priv directory for a test case, which would cause Test
- Server failure. This error has been corrected.</p>
- <p>
- Own Id: OTP-13181</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.9</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- The status of an aborted test due to test suite
- compilation error has changed from 'auto_skipped' to
- 'failed'. This affects both the textual log file, event
- handling and CT hook callbacks. The logging of
- compilation failures has also been improved, especially
- in the case of multiple test suites failing compilation.</p>
- <p>
- Own Id: OTP-10816</p>
- </item>
- <item>
- <p>
- The Test Server source code parser (erl2html2) failed to
- handle the macro tuple in the syntax tree returned by
- epp_dodger. This error has been corrected.</p>
- <p>
- Own Id: OTP-12740</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- The Test Server application has been marked as obsolete
- and will be removed from OTP in the next major release
- (OTP 19.0).</p>
- <p>
- Own Id: OTP-10923 Aux Id: OTP-12705 </p>
- </item>
- <item>
- <p>
- When running OTP tests using the ts interface, it is now
- possible to specify so called test categories per OTP
- application. A test category is represented by a CT test
- specification and defines an arbitrary subset of existing
- test suites, groups and cases. Examples of test
- categories are 'smoke' (smoke tests) and 'bench'
- (benchmarks). (Call ts:help() for more info). Also,
- functions for reading terms from the current test
- specification during test, ct:get_testspec_terms/0 and
- ct:get_testspec_terms/1, have been implemented.</p>
- <p>
- Own Id: OTP-11962</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.8.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- If the last expression in a test case causes a timetrap
- timeout, the stack trace is ignored and not printed to
- the test case log file. This happens because the
- {Suite,TestCase,Line} info is not available in the stack
- trace in this scenario, due to tail call elimination.
- Common Test has been modified to handle this situation by
- inserting a {Suite,TestCase,last_expr} tuple in the
- correct place and printing the stack trace as expected.</p>
- <p>
- Own Id: OTP-12697 Aux Id: seq12848 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.8</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- When installing test suites in a cross compilation
- environment, ts_install was not able to read the values
- of the environment variables specified in the
- configuration file. This has been fixed.</p>
- <p>
- Own Id: OTP-11441</p>
- </item>
- <item>
- <p>
- Printouts by means of ct:log/2/3 or ct:pal/2/3 from the
- hook functions on_tc_fail/2 and on_tc_skip/2 would (quite
- unexpectedly) end up in the "unexpected i/o" log file
- instead of in the test case log file. This behaviour has
- been changed so that now, all printouts (including stdio
- printouts) from these hook functions will be routed to
- the test case log file.</p>
- <p>
- Own Id: OTP-12468</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- The format of the information printed on top of the test
- case (and configuration function) log file has been
- slightly modified, mainly in order to make the start
- configuration data easier to read and interpret.</p>
- <p>
- Own Id: OTP-12518 Aux Id: seq12808 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.7.2</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- The source code to html code generator in Test Server
- (and Common Test) would fail to generate anchors in the
- html code for functions with non-expandable macros,
- resulting in bad html links to such functions. This
- correction lets the code generator ignore macros that
- can't be expanded (i.e. not pre-process them), so that
- correct anchors will always be produced.</p>
- <p>
- Own Id: OTP-11766 Aux Id: seq12556 </p>
- </item>
- <item>
- <p>
- Make sure to install .hrl files when needed</p>
- <p>
- Own Id: OTP-12197</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Distribute <c>autoconf</c> helpers to applications at
- build time instead of having multiple identical copies
- committed in the repository.</p>
- <p>
- Own Id: OTP-12348</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.7.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- The mechanism for running code cover analysis with
- common_test has been improved. Earlier, if a test run
- consisted of multiple tests, cover would be started and
- stopped for each test. This would give "intermediate"
- cover logs available from the "Coverage log" link on the
- test suite result pages. To accumulate cover data over
- all tests, the 'export' option had to be used in the
- cover spec file. This was not well documented, and the
- functionality was quite confusing.</p>
- <p>
- Using the 'nodes' option in the cover spec file would
- fail when the test run consisted of multiple tests, since
- the specified nodes would only be included in the cover
- analysis of the first test.</p>
- <p>
- The repeated compilation and analysis of the same modules
- was also very time consuming.</p>
- <p>
- To overcome these problems, ct will now only cover
- compile and analyze modules once per test run, i.e. once
- for each cover spec file. The log file is available via a
- new button on the top level index page. The old "Coverage
- log" links on the test suite result pages still exist,
- but they all point to the same log containing the
- accumulated result.</p>
- <p>
- Own Id: OTP-11971</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.7</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Application upgrade (appup) files are corrected for the
- following applications: </p>
- <p>
- <c>asn1, common_test, compiler, crypto, debugger,
- dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe,
- inets, observer, odbc, os_mon, otp_mibs, parsetools,
- percept, public_key, reltool, runtime_tools, ssh,
- syntax_tools, test_server, tools, typer, webtool, wx,
- xmerl</c></p>
- <p>
- A new test utility for testing appup files is added to
- test_server. This is now used by most applications in
- OTP.</p>
- <p>
- (Thanks to Tobias Schlager)</p>
- <p>
- Own Id: OTP-11744</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Calls to erlang:open_port/2 with 'spawn' are updated to
- handle space in the command path.</p>
- <p>
- Own Id: OTP-10842</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.6.4</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>The way Common Test handles skipping of test cases has
- been updated. In previous versions, returning
- <c>{skip,Reason}</c> from a configuration function (such
- as init_per_suite or init_per_group), resulted in all
- affected test cases getting skipped with status
- <c>auto_skipped</c>. This was inappropriate, since this
- status is supposed to be used to inform that Common Test
- has taken the initiative to skip something (e.g. a test
- case group if init_per_group failed). Therefore, in this
- version of Common Test, whenever the user skips a suite,
- group, or individual test case (by means of a
- configuration function or test specification term), the
- affected test cases get the status <c>user_skipped</c>
- instead.</p> <p>This update has meant a few changes that
- may affect Common Test users in various ways:</p> <list>
- <item>The test results and statistics will be affected,
- which is important to know when running regression tests
- and comparing results to previous test runs.</item>
- <item>Users that read or parse the textual log file
- <c>suite.log</c> will notice that an auto skipped
- function is now reported as <c>auto_skipped</c> rather
- than <c>skipped</c> as before.</item> <item>When
- <c>require</c> fails in an info function (such as suite/0
- or group/1), all affected configuration functions and
- test cases are marked as <c>auto_skipped</c>.</item>
- <item>If Common Test detects an error in the test suite
- (such as e.g. an invalid all/0 function), all affected
- configuration functions and test cases are marked as
- <c>auto_skipped</c>.</item> <item>If a repeated test run
- session reaches a deadline with <c>force_stop</c>
- enabled, all remaining test cases are marked as
- <c>auto_skipped</c> rather than <c>user_skipped</c> as
- before.</item> <item>The event messages that Common Test
- generates during test runs have been affected by this
- update. For details see OTP-11524.</item> </list>
- <p>
- Own Id: OTP-11305 Aux Id: OTP-11524 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.6.3</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Test Server installed an error handler (test_server_h)
- only to be able to write the name of the current test
- case to stdout whenever it received an error- or progress
- report. This functionality was not useful and has been
- removed. The built-in Common Test hook, cth_log_redirect,
- has instead been improved to now also tag all error- and
- progress reports in the log with suite-, group-, and/or
- test case name.</p>
- <p>
- Own Id: OTP-11263 Aux Id: seq12251 </p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- A new log, the "Pre- and Post Test I/O Log", has been
- introduced, which makes it possible to capture error- and
- progress reports, as well as printouts made with ct:log/2
- and ct:pal/2, before and after a test run. (Some minor
- improvements of the logging system have been made at the
- same time). Links to the new log are found on the Common
- Test Framework Log page. The Common Test User's Guide has
- been updated with information about the new log and also
- with a new section on how to synchronize external
- applications with Common Test by means of the CT Hook
- init and terminate functions.</p>
- <p>
- Own Id: OTP-11272</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Known Bugs and Problems</title>
- <list>
- <item>
- <p>
- Test Server: Report auto_skipped in major log.</p>
- <p>
- Own Id: OTP-11297</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.6.2</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Some unused code related to remote targets is removed,
- and documentation is updated.</p>
- <p>
- Own Id: OTP-10607 Aux Id: kunagi-338 [249] </p>
- </item>
- <item>
- <p>
- A bug in test_server_gl caused io requests containing
- invalid data (i.e. not unicode:chardata()) to hang, since
- no io reply was sent. This has been corrected.</p>
- <p>
- Own Id: OTP-10991</p>
- </item>
- <item>
- <p>
- Common Test would, in case of timetrap error, print a
- warning in the log if end_per_testcase wasn't implemented
- in the suite, even though it's an optional function. This
- printout has been removed.</p>
- <p>
- Own Id: OTP-11052</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- The '-force_stop' flag to use with time-limited repeats
- of test runs can now be used with a new 'skip_rest'
- option which causes the rest of the test cases in the
- ongoing test job to be skipped when the time limit is
- reached. E.g. 'ct_run -spec xxx -duration 010000
- -force_stop skip_rest'</p>
- <p>
- Own Id: OTP-10856 Aux Id: OTP-10832 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.6.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- The unicode update of test_server for R16A introduced a
- few potential errors when logging to files. Sometimes ~tp
- or ~ts was used for formatting also when writing to files
- that were not opened with the {encoding,utf8} option. If
- then the argument contained unicode characters above 255,
- the file descriptor would crash. This has been corrected
- by the following modifications:</p> <list> <item> Since the
- 'unexpected_io' log file is used only when the test case
- HTML file is not available (e.g. between test cases),
- this file is now also a HTML file and as other
- test_server HTML logs it is always UTF-8 encoded </item>
- <item> Since it is possible to change which information
- is going to which log file (with
- test_server_ctrl:set_levels/3), we do not have full
- control over which information is written to which file.
- This means that any printout could be written to the
- 'major' log file (suite.log), which was earlier encoded
- as latin1. To avoid crashing this file descriptor due to
- unicode strings, the 'major' log file is now also encoded
- in UTF-8 (possible incopatibility). </item> <item> The
- cross_cover.info file is no longer a text file which can
- be read with file:consult/1, instead it is written as a
- pure binary file using term_to_binary when writing and
- binary_to_term when reading. </item> <item> The encoding
- of the file named 'last_name', which only content is the
- path to the last run.&lt;timestamp&gt; directory, is now
- dependent on the file name mode of the VM. If file names
- are expected to be unicode, then the 'last_name' file is
- UTF-8 encoded, else it is latin1 encoded. </item> </list>
- <p>
- Also, ~tp has been changed back to ~p unless it is
- somehow likely that the argument includes strings. It is
- not obvious that this is the correct thing to do, but
- some decission had to be taken...</p>
- <p>
- Own Id: OTP-10780</p>
- </item>
- <item>
- <p>
- Using the force_stop flag/option to interrupt a test run
- caused a crash in Common Test. This problem has been
- solved.</p>
- <p>
- Own Id: OTP-10832</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.6</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Line numbering of erlang files that were not correctly
- indented could be wrong after coverting to html with
- erl2html2:convert/[2,3] (the source code pointed to from
- the test case). This has been corrected.</p>
- <p>
- Also, there are now link targets for each line and not
- only for each 10th line, and link targets for functions
- now include the arity and not only the function name
- (e.g. func/1 has a link target "func-1").</p>
- <p>
- Own Id: OTP-9710 Aux Id: seq11945, kunagi-201 [112] </p>
- </item>
- <item>
- <p>
- Severe errors detected by <c>test_server</c> (e.g. if log
- files directories cannot be created) will now be reported
- to <c>common_test</c> and noted in the <c>common_test</c>
- logs.</p>
- <p>
- Own Id: OTP-9769 Aux Id: kunagi-202 [113] </p>
- </item>
- <item>
- <p>
- The earlier undocumented cross cover feature for
- accumulating cover data over multiple tests has now been
- fixed and documented.</p>
- <p>
- Own Id: OTP-9870 Aux Id: kunagi-206 [117] </p>
- </item>
- <item>
- <p>
- If the test suite itself was included in code coverage
- analysis, then the test_server would not manage to set
- data_dir correctly for the test. This has been corrected.</p>
- <p>
- Own Id: OTP-9956 Aux Id: kunagi-207 [118] </p>
- </item>
- <item>
- <p>
- Any call to test_server:break/1 should cancel all active
- timetramps. However, in some cases
- Suite:end_per_testcase/2 is executed on a different
- process than the test case itself, and if
- test_server:break/1 was called from there, the timetraps
- were not cancelled. This has been corrected.</p>
- <p>
- Own Id: OTP-10046 Aux Id: kunagi-174 [85] </p>
- </item>
- <item>
- <p>When a test case failed because of a timetrap time
- out, the <c>Config</c> data for the case was lost in the
- following call to <c>end_per_testcase/2</c>, and also in
- calls to the CT Hook function
- <c>post_end_per_testcase/4</c>. This problem has been
- solved and the <c>Config</c> data is now correctly passed
- to the above functions after a timetrap timeout
- failure.</p>
- <p>
- Own Id: OTP-10070 Aux Id: kunagi-175 [86] </p>
- </item>
- <item>
- <p>In test_server, the same process would supervise the
- currently running test case and be group leader (and IO
- server) for the test case. Furthermore, when running
- parallel test cases, new temporary supervisor/group
- leader processes were spawned and the process that was
- group leader for sequential test cases would not be
- active. That would lead to several problems:</p>
- <p>* Processes started by init_per_suite will inherit the
- group leader of the init_per_suite process (and that
- group leader would not process IO requests when parallel
- test cases was running). If later a parallel test case
- caused such a processto print using (for example)
- io:format/2, the calling would hang.</p>
- <p>* Similarly, if a process was spawned from a parallel
- test case, it would inherit the temporary group leader
- for that parallel test case. If that spawned process
- later - when the group of parallel tests have finished -
- attempted to print something, its group leader would be
- dead and there would be <c>badarg</c> exception.</p>
- <p>Those problems have been solved by having group
- leaders separate from the processes that supervises the
- test cases, and keeping temporary group leader process
- for parallel test cases alive until no more process in
- the system use them as group leaders.</p>
- <p>Also, a new <c>unexpected_io.log</c> log file
- (reachable from the summary page of each test suite) has
- been introduced. All unexpected IO will be printed into
- it(for example, IO to a group leader for a parallel test
- case that has finished).</p>
- <p>
- Own Id: OTP-10101 Aux Id: OTP-10125 </p>
- </item>
- <item>
- <p>
- The stability of <c>common_test</c> and
- <c>test_server</c> when running test cases in parallel
- has been improved.</p>
- <p>
- Own Id: OTP-10480 Aux Id: kunagi-318 [229] </p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Added a general framework for executing benchmarks of
- Erlang/OTP. Benchmarks for the Erlang VM and mnesia have
- been incorporated in the framework. </p>
- <p>
- For details about how to add more benchmarks see
- $ERL_TOP/HOWTO/BENCHMARKS.md in the source distribution.</p>
- <p>
- Own Id: OTP-10156</p>
- </item>
- <item>
- <p>
- Update common test modules to handle Unicode:</p> <list>
- <item> Use UTF-8 encoding for all HTML files, except the
- HTML version of the test suite generated with
- erl2html2:convert, which will have the same encoding as
- the original test suite (.erl) file. </item> <item>
- Encode link targets in HTML files with
- test_server_ctrl:uri_encode/1. </item> <item> Use unicode
- modifier 't' with ~s when appropriate. </item> <item> Use
- unicode:characters_to_list and
- unicode:characters_to_binary for conversion between
- binaries and strings instead of binary_to_list and
- list_to_binary. </item> </list>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.5.3</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- test_server_h will now recognize info_reports written by
- ct connection handlers (according to the description in
- cth_conn_log) and ignore them as they will be completely
- handled by by ct_conn_log_h.</p>
- <p>
- Earlier test_server_h would print a tag (testcase name)
- before forwarding the report to error_logger_tty_h. This
- would cause lots of tags in the log with no info report
- following (since error_logger_tty_h did not handle them).</p>
- <p>
- Own Id: OTP-10571</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Known Bugs and Problems</title>
- <list>
- <item>
- <p>
- Restore Config data if lost when test case fails.</p>
- <p>
- Own Id: OTP-10070 Aux Id: kunagi-175 [86] </p>
- </item>
- <item>
- <p>
- IO server error in test_server.</p>
- <p>
- Own Id: OTP-10125 Aux Id: OTP-10101, kunagi-177 [88] </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.5.2</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- The documentation has been updated with the latest
- changes for the test_server_ctrl:report/2 function.</p>
- <p>
- Own Id: OTP-10086 Aux Id: seq12066 </p>
- </item>
- <item>
- <p>
- The ct:get_status/0 function failed to report status if a
- parallel test case group was running at the time of the
- call. This has been fixed and the return value for the
- function has been updated. Please see the ct reference
- manual for details.</p>
- <p>
- Own Id: OTP-10172</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- It is now possible to sort the HTML tables by clicking on
- the header elements. In order to reset a sorted table,
- the browser window should simply be refreshed. This
- feature requires that the browser supports javascript,
- and has javascript execution enabled. If the 'ct_run
- -basic_html' flag is used, no javascript code is included
- in the generated HTML code.</p>
- <p>
- Own Id: OTP-9896 Aux Id: seq12034, OTP-9835 </p>
- </item>
- <item>
- <p>
- Verbosity levels for log printouts has been added. This
- makes it possible to specify preferred verbosity for
- different categories of log printouts, as well as general
- printouts (such as standard IO), to allow control over
- which strings get printed and which get ignored. New
- versions of the Common Test logging functions, ct:log,
- ct:pal and ct:print, have been introduced, with a new
- Importance argument added. The Importance value is
- compared to the verbosity level at runtime. More
- information can be found in the chapter about Logging in
- the Common Test User's Guide.</p>
- <p>
- Own Id: OTP-10067 Aux Id: seq12050 </p>
- </item>
- <item>
- <p>
- The Erlang/OTP test runner ts has been extended to allow
- cross compilation of test suites. To cross compile the
- test suites first follow the normal cross compilation
- procedures and release the tests on the build host. Then
- install ts using an xcomp specification file and compile
- test suites using ts:compile_testcases/0. For more
- details see $ERL_TOP/xcomp/README.md.</p>
- <p>
- Own Id: OTP-10074</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.5.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- After a test case timeout or abortion, the
- end_per_testcase function executes on a new dedicated
- process. The group leader for this process should be set
- to the IO server for the test case, which was not done
- properly. The result of this error was that no warnings
- about end_per_testcase failing or timing out were ever
- printed in the test case log. Also, help functions such
- as e.g. test_server:stop_node/1, attempting to
- synchronize with the IO server, would hang. The fault has
- been corrected.</p>
- <p>
- Own Id: OTP-9666</p>
- </item>
- <item>
- <p>
- A deadlock situation could occur if Common Test is
- forwarding error_handler printouts to Test Server at the
- same time a new test case is starting. This error has
- been fixed.</p>
- <p>
- Own Id: OTP-9894</p>
- </item>
- <item>
- <p>
- When a test case was killed because of a timetrap
- timeout, the current location (suite, case and line) was
- not printed correctly in the log files. This has been
- corrected.</p>
- <p>
- Own Id: OTP-9930 Aux Id: seq12002 </p>
- </item>
- <item>
- <p>
- Test Server and Common Test would add new error handlers
- with each test run and fail to remove previously added
- ones. In the case of Test Server, this would only happen
- if SASL was not running on the test node. This has been
- fixed.</p>
- <p>
- Own Id: OTP-9941 Aux Id: seq12009 </p>
- </item>
- <item>
- <p>
- If a test case process was terminated due to an exit
- signal from a linked process, Test Server failed to
- report the correct name of the suite and case to the
- framework. This has been corrected.</p>
- <p>
- Own Id: OTP-9958 Aux Id: OTP-9855 </p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- A new optional feature has been introduced that enables
- Common Test to generate priv_dir directory names that are
- unique for each test case or config function. The name of
- the option/flag is 'create_priv_dir' and it can be set to
- value 'auto_per_run' (which is the default, existing,
- behaviour), or 'auto_per_tc' or 'manual_per_tc'. If
- 'auto_per_tc' is used, Test Server creates a dedicated
- priv_dir automatically for each test case (which can be
- very expensive in case of many and/or repeated cases). If
- 'manual_per_tc' is used, the user needs to create the
- priv_dir explicitly by calling the new function
- ct:make_priv_dir/0.</p>
- <p>
- Own Id: OTP-9659 Aux Id: seq11930 </p>
- </item>
- <item>
- <p>
- A column for test case group name has been added to the
- suite overview HTML log file.</p>
- <p>
- Own Id: OTP-9730 Aux Id: seq11952 </p>
- </item>
- <item>
- <p>
- It is now possible to use the post_end_per_testcase CT
- hook function to print a comment for a test case in the
- overview log file, even if the test case gets killed by a
- timetrap or unknown exit signal, or if the
- end_per_testcase function times out.</p>
- <p>
- Own Id: OTP-9855 Aux Id: seq11979 </p>
- </item>
- <item>
- <p>
- Common Test will now print error information (with a time
- stamp) in the test case log file immediately when a test
- case fails. This makes it easier to see when, in time,
- the fault actually occured, and aid the job of locating
- relevant trace and debug printouts in the log.</p>
- <p>
- Own Id: OTP-9904 Aux Id: seq11985, OTP-9900 </p>
- </item>
- <item>
- <p>
- Test Server has been modified to check the SASL
- errlog_type parameter when receiving an error logger
- event, so that it doesn't print reports of type that the
- user has disabled.</p>
- <p>
- Own Id: OTP-9955 Aux Id: seq12013 </p>
- </item>
- <item>
- <p>
- If an application cannot be found by ts it is
- automatically skipped when testing.</p>
- <p>
- Own Id: OTP-9971</p>
- </item>
- <item>
- <p>
- By specifying a user defined function ({M,F,A} or fun) as
- timetrap value, either by means of an info function or by
- calling ct:timetrap/1, it is now possible to set a
- timetrap that will be triggered when the user function
- returns.</p>
- <p>
- Own Id: OTP-9988 Aux Id: OTP-9501, seq11894 </p>
- </item>
- <item>
- <p>
- If the optional configuration functions init_per_suite/1
- and end_per_suite/1 are not implemented in the test
- suite, local Common Test versions of these functions are
- called instead, and will be displayed in the overview log
- file. Any printouts made by the pre- or
- post_init_per_suite and pre- or post_end_per_suite hook
- functions are saved in the log files for these functions.</p>
- <p>
- Own Id: OTP-9992</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.5</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- The test case group info function has been implemented in
- Common Test. Before execution of a test case group, a
- call is now made to <c>TestSuite:group(GroupName)</c>.
- The function returns a list of test properties, e.g. to
- specify timetrap values, require configuration data, etc
- (analogue to the test suite- and test case info
- function). The scope of the properties set by
- <c>group(GroupName)</c> is all test cases and sub-groups
- of group <c>GroupName</c>.</p>
- <p>
- Own Id: OTP-9235</p>
- </item>
- <item>
- <p>
- The look of the HTML log files generated by Common Test
- and Test Server has been improved (and made easier to
- customize) by means of a CSS file.</p>
- <p>
- Own Id: OTP-9706</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Known Bugs and Problems</title>
- <list>
- <item>
- <p>
- Fix problems in CT/TS due to line numbers in exceptions.</p>
- <p>
- Own Id: OTP-9203</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.4.5</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- An error in how comments are colored in the test suite
- overview html log file has been corrected. As result, a
- new framework callback function, format_comment/1, has
- been introduced.</p>
- <p>
- Own Id: OTP-9237</p>
- </item>
- <item>
- <p>
- Test Server did not release SASL TTY handlers
- (sasl_report_tty_h and error_logger_tty_h) properly after
- each test run. This error has been fixed.</p>
- <p>
- Own Id: OTP-9311</p>
- </item>
- <item>
- <p>
- Automatically generated init- and end-configuration
- functions for test case groups caused incorrect execution
- order of test cases. This has been corrected.</p>
- <p>
- Own Id: OTP-9369</p>
- </item>
- <item>
- <p>
- If ct:log/2 was called with bad arguments, this could
- cause the Common Test IO handling process to crash. This
- fault has been corrected.</p>
- <p>
- Own Id: OTP-9371 Aux Id: OTP-8933 </p>
- </item>
- <item>
- <p>
- A bug has been fixed that made Test Server call the
- end_tc/3 framework function with an incorrect module name
- as first argument.</p>
- <p>
- Own Id: OTP-9379 Aux Id: seq11863 </p>
- </item>
- <item>
- <p>
- If end_per_testcase caused a timetrap timeout, the actual
- test case status was discarded and the test case logged
- as successful (even if the case had actually failed
- before the call to end_per_testcase). This fault has been
- fixed.</p>
- <p>
- Own Id: OTP-9397</p>
- </item>
- <item>
- <p>
- If a timetrap timeout occured during execution of of a
- function in a lib module (i.e. a function called directly
- or indirectly from a test case), the Suite argument in
- the end_tc/3 framework callback function would not
- correctly contain the name of the test suite, but the lib
- module. (This would only happen if the lib module was
- compiled with ct.hrl included). This error has been
- solved.</p>
- <p>
- Own Id: OTP-9398</p>
- </item>
- <item>
- <p>
- Add a proplist() type</p>
- <p>
- Recently I was adding specs to an API and found that
- there is no canonical proplist() type defined. (Thanks to
- Ryan Zezeski)</p>
- <p>
- Own Id: OTP-9499</p>
- </item>
- <item>
- <p> XML files have been corrected. </p>
- <p>
- Own Id: OTP-9550 Aux Id: OTP-9541 </p>
- </item>
- <item>
- <p>
- If a test suite would start with a test case group
- defined without the init_per_group/2 and end_per_group/2
- function, init_per_suite/1 would not execute initially
- and logging of the test run would fail. This error has
- been fixed.</p>
- <p>
- Own Id: OTP-9584</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- A new option, 'logopts', has been introduced, to make it
- possible to modify some aspects of the logging behaviour
- in Common Test (or Test Server). For example, whenever an
- io printout is made, test_server adds newline (\n) to the
- end of the output string. This may not always be a
- preferred action and can therefore be disabled by means
- of "ct_run ... -logopts no_nl" (or ct:run_test([...,
- {logopts,[no_nl]}])). A new framework callback function,
- get_logopts/0, has been introduced (see the ct_framework
- module for details).</p>
- <p>
- Own Id: OTP-9372 Aux Id: OTP-9396 </p>
- </item>
- <item>
- <p>
- A new option, 'logopts', has been introduced, to make it
- possible to modify some aspects of the logging behaviour
- in Common Test (or Test Server). For example, if the html
- version of the test suite source code should not be
- generated during the test run (and consequently be
- unavailable in the log file system), the feature may be
- disabled by means of "ct_run ... -logopts no_src" (or
- ct:run_test([..., {logopts,[no_src]}])). A new framework
- callback function, get_logopts/0, has been introduced
- (see the ct_framework module for details).</p>
- <p>
- Own Id: OTP-9396 Aux Id: seq11869, OTP-9372 </p>
- </item>
- <item>
- <p>
- It is now possible to use a tuple {M,F,A}, or a fun, as
- timetrap specification in the suite info function or test
- case info functions. The function must return a valid
- timeout value, as documented in the common_test man page
- and in the User's Guide.</p>
- <p>
- Own Id: OTP-9501 Aux Id: seq11894 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.4.4</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- It was previously not possible to use timetrap value
- 'infinity' with ct:timetrap/1. This has been fixed.</p>
- <p>
- Own Id: OTP-9159</p>
- </item>
- <item>
- <p>
- A bug that made it impossible to cancel the previous
- timetrap when calling ct:timetrap/1 has been corrected.</p>
- <p>
- Own Id: OTP-9233 Aux Id: OTP-9159 </p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- When running tests with auto-compilation disabled, Common
- Test could only display the test suite source code on
- html format in the test case log if the source file was
- located in the same directory as the pre-compiled suite.
- This has been modified so that Common Test now tries to
- locate the source file by means of the test suite module
- info (Suite:module_info/1). As a result, a suite may now
- be compiled to a different output directory (e.g.
- $MYTEST/bin) than the source code directory (e.g.
- $MYTEST/src), without the source-code-to-html generation
- being affected.</p>
- <p>
- Own Id: OTP-9138</p>
- </item>
- <item>
- <p>
- It is now possible to return a tuple {fail,Reason} from
- init_per_testcase/2. The result is that the associated
- test case gets logged as failed without ever executing.</p>
- <p>
- Own Id: OTP-9160 Aux Id: seq11502 </p>
- </item>
- <item>
- <p>
- Added DragonflyBSD check in test_server configure.</p>
- <p>
- Own Id: OTP-9249</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.4.3</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Updated the ts*.config files to contain information
- relevant to testing Erlang/OTP in an open source
- environment.</p>
- <p>
- Own Id: OTP-9017</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Alpha release of Common Test Hooks (CTH). CTHs allow the
- users of common test to abtract out common behaviours
- from test suites in a much more elegant and flexible way
- than was possible before. Note that the addition of this
- feature may introduce minor changes in the undocumented
- behaviour of the interface inbetween common_test and
- test_server.</p>
- <p>
- *** POTENTIAL INCOMPATIBILITY ***</p>
- <p>
- Own Id: OTP-8851</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.4.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Miscellaneous updates</p>
- <p>
- Own Id: OTP-8976</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.4.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Returning {return_group_result,failed} from end_per_group
- in a group that is part of a sequence, did not cause the
- proceeding cases (or groups) to get skipped. This has
- been fixed.</p>
- <p>
- Own Id: OTP-8753 Aux Id: seq11644 </p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Common Test has been updated to handle start options and
- test specification terms for test case groups (and test
- cases in groups). Also, an option named 'label', has been
- added that associates the test run with a name that
- Common Test prints in the overview HTML logs.</p>
- <p>
- Own Id: OTP-8725 Aux Id: OTP-8727 </p>
- </item>
- <item>
- <p>
- It is now possible to skip all tests in a suite, or a
- group, by returning {fail,Reason} from the end_tc/5
- framework function for init_per_suite, or init_per_group.</p>
- <p>
- Own Id: OTP-8805 Aux Id: seq11664 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.4</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Returning {fail,Reason} from the framework end_tc
- function was not handled properly by Test Server for all
- test suite functions.</p>
- <p>
- Own Id: OTP-8492 Aux Id: seq11502 </p>
- </item>
- <item>
- <p>
- If the framework end_tc function would hang and get
- aborted by Test Server, there was no indication of
- failure in the logs. This has been fixed.</p>
- <p>
- Own Id: OTP-8682 Aux Id: seq11504 </p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- It is now possible for the Test Server framework end_tc
- function to change the status of the test case from ok or
- auto-skipped to failed by returning {fail,Reason}.</p>
- <p>
- Own Id: OTP-8495 Aux Id: seq11502 </p>
- </item>
- <item>
- <p>
- Test Server will now call the end_per_testcase/2 function
- even if the test case has been terminated explicitly
- (with abort_current_testcase/1), or after a timetrap
- timeout. Under these circumstances the return value of
- end_per_testcase is completely ignored. Therefore the
- function will not be able to change the reason for test
- case termination by returning {fail,Reason}, nor will it
- be able to save data with {save_config,Data}.</p>
- <p>
- Own Id: OTP-8500 Aux Id: seq11521 </p>
- </item>
- <item>
- <p>
- Previously, a repeat property of a test case group
- specified the number of times the group should be
- repeated after the main test run. I.e. {repeat,N} would
- case the group to execute 1+N times. To be consistent
- with the behaviour of the run_test repeat option, this
- has been changed. N now specifies the absolute number of
- executions instead.</p>
- <p>
- Own Id: OTP-8689 Aux Id: seq11502 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.3.6</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- The Test Server parse transform did not handle bit string
- comprehensions. This has been fixed.</p>
- <p>
- Own Id: OTP-8458 Aux Id: OTP-8311 </p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- The tc_status value in the Config list for a test case
- that has failed because of a timetrap timeout, has
- changed from {tc_status,timeout} to
- {tc_status,timetrap_timeout}.</p>
- <p>
- Own Id: OTP-8302</p>
- </item>
- <item>
- <p>The documentation is now possible to build in an open
- source environment after a number of bugs are fixed and
- some features are added in the documentation build
- process. </p>
- <p>- The arity calculation is updated.</p>
- <p>- The module prefix used in the function names for
- bif's are removed in the generated links so the links
- will look like
- "http://www.erlang.org/doc/man/erlang.html#append_element-2"
- instead of
- "http://www.erlang.org/doc/man/erlang.html#erlang:append_element-2".</p>
- <p>- Enhanced the menu positioning in the html
- documentation when a new page is loaded.</p>
- <p>- A number of corrections in the generation of man
- pages (thanks to Sergei Golovan)</p>
- <p>- The legal notice is taken from the xml book file so
- OTP's build process can be used for non OTP
- applications.</p>
- <p>
- Own Id: OTP-8343</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.3.5</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- If the init_per_testcase/2 function fails, the test case
- now gets marked and counted as auto skipped, not user
- skipped (which would previously happen).</p>
- <p>
- Own Id: OTP-8289</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- The documentation is now built with open source tools
- (xsltproc and fop) that exists on most platforms. One
- visible change is that the frames are removed.</p>
- <p>
- Own Id: OTP-8201</p>
- </item>
- <item>
- <p>
- It is now possible to fail a test case from the
- end_per_testcase/2 function, by returning {fail,Reason}.</p>
- <p>
- Own Id: OTP-8284</p>
- </item>
- <item>
- <p>
- It is now possible to fail a test case by having the
- end_tc/3 framework function return {fail,Reason} for the
- test case.</p>
- <p>
- Own Id: OTP-8285</p>
- </item>
- <item>
- <p>
- The test_server framework API (e.g. the end_tc/3
- function) has been modified. See the test_server_ctrl
- documentation for details.</p>
- <p>
- Own Id: OTP-8286 Aux Id: OTP-8285, OTP-8287 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.3.4</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- When running a suite starting with a test case group,
- Test Server crashed if init_per_suite/1 exited or
- returned skip. This has been fixed.</p>
- <p>
- Own Id: OTP-8105 Aux Id: OTP-8089 </p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Various updates and fixes in Common Test and Test Server.</p>
- <p>
- Own Id: OTP-8045 Aux Id: OTP-8089,OTP-8105,OTP-8163 </p>
- </item>
- <item>
- <p>
- Errors in coverage data collection and analysis were
- difficult to detect. The logging has been improved so
- that more information about e.g. imported and missing
- modules is printed to the html log files.</p>
- <p>
- Own Id: OTP-8163 Aux Id: seq11374 </p>
- </item>
- <item>
- <p>
- The Common Test HTML overview pages have been improved.
- It is now possible to see if a test case has been skipped
- explicitly or because a configuration function has
- failed. Also, the history page (all_runs.html) now has
- scrolling text displaying the test names. The old format
- (showing names as a truncated string) can still be
- generated by means of the flag/option 'basic_html'.</p>
- <p>
- Own Id: OTP-8177</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.3.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Various corrections and improvements of Common Test and
- Test Server.</p>
- <p>
- Own Id: OTP-7981</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.3.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Minor updates and corrections.</p>
- <p>
- Own Id: OTP-7897</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.3</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- The conf case in Test Server has been extended with
- properties that make it possible to execute test cases in
- parallel, in sequence and in shuffled order. It is now
- also possible to repeat test cases according to different
- criterias. The properties can be combined, making it
- possible to e.g. repeat a conf case a certain number of
- times and execute the test cases in different (random)
- order every time. The properties are specified in a list
- in the conf case definition: {conf, Properties, InitCase,
- TestCases, EndCase}. The available properties are:
- parallel, sequence, shuffle, repeat, repeat_until_all_ok,
- repeat_until_any_ok, repeat_until_any_fail,
- repeat_until_all_fail.</p>
- <p>
- Own Id: OTP-7511 Aux Id: OTP-7839 </p>
- </item>
- <item>
- <p>The test server starts Cover on nodes of the same
- version as the test server itself only.</p>
- <p>
- Own Id: OTP-7699</p>
- </item>
- <item>
- <p>
- The Erlang mode for Emacs has been updated with new and
- modified skeletons for Common Test and TS. Syntax for
- test case groups in Common Test (and conf cases with
- properties in TS) has been added and a new minimal Common
- Test suite skeleton has been introduced.</p>
- <p>
- Own Id: OTP-7856</p>
- </item>
- </list>
- </section>
-
-</section>
-<section><title>Test_Server 3.2.4.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- The step functionality in Common Test (based on
- interaction with Debugger) was broken. This has been
- fixed, and some new step features have also been added.
- Please see the Common Test User's Guide for details.</p>
- <p>
- Own Id: OTP-7800 Aux Id: seq11106 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.2.4</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Miscellaneous updates.</p>
- <p>
- Own Id: OTP-7527</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.2.3</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- When a testcase terminated due to a timetrap, io sent to
- the group leader from framework:end_tc/3 (using
- ct:pal/2/3 or ct:log/2/3) would cause deadlock. This has
- been fixed.</p>
- <p>
- Own Id: OTP-7447 Aux Id: seq11010 </p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Various updates and improvements, plus some minor bug
- fixes, have been implemented in Common Test and Test
- Server.</p>
- <p>
- Own Id: OTP-7112</p>
- </item>
- <item>
- <p>
- It is now possible, by means of the new function
- ct:abort_current_testcase/1 or
- test_server_ctrl:abort_current_testcase/1, to abort the
- currently executing test case.</p>
- <p>
- Own Id: OTP-7518 Aux Id: OTP-7112 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.2.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p><c>erlang:system_info/1</c> now accepts the
- <c>logical_processors</c>, and <c>debug_compiled</c>
- arguments. For more info see the, <c>erlang(3)</c>
- documentation.</p> <p>The scale factor returned by
- <c>test_server:timetrap_scale_factor/0</c> is now also
- effected if the emulator uses a larger amount of
- scheduler threads than the amount of logical processors
- on the system. </p>
- <p>
- Own Id: OTP-7175</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.2.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- When init_per_suite or end_per_suite terminated due to
- runtime failure, test_server failed to format the line
- number information properly and crashed. This error has
- now been fixed.</p>
- <p>
- Own Id: OTP-7091</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Test_Server 3.2.0</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Test Server is a portable test server for automated
- application testing. The server can run test suites on
- local or remote targets and log progress and results to
- HTML pages. The main purpose of Test Server is to act as
- engine inside customized test tools. A callback interface
- for such framework applications is provided.</p>
- <p>
- Own Id: OTP-6989</p>
- </item>
- </list>
- </section>
-
-</section>
-
-</chapter>
-
diff --git a/lib/test_server/doc/src/notes_history.xml b/lib/test_server/doc/src/notes_history.xml
deleted file mode 100644
index ca7880d74f..0000000000
--- a/lib/test_server/doc/src/notes_history.xml
+++ /dev/null
@@ -1,113 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2006</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Test Server Release Notes History</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
-
- <section>
- <title>Test Server 3.1.1</title>
-
- <section>
- <title>Improvements and new features</title>
- <list type="bulleted">
- <item>
- <p>Added functions <c>test_server:break/1</c> and
- <c>test_server:continue/0</c> for semiautomatic testing.</p>
- <p><c>test_server:timetrap/1</c> can now also take
- <c>{hours,H} | {minutes,M | {seconds,S}</c>.</p>
- <p>Added function
- <c>test_server_ctrl:multiply_timetraps/1</c>,
- <c>test_server_ctrl:add_case/3</c>,
- <c>test_server_ctrl:add_cases/2/3</c>.</p>
- <p>Added test suite functions <c>init_per_suite/1</c> and
- <c>end_per_suite/1</c>.</p>
- <p><c>fin_per_testcase/2</c> is changed to
- <c>end_per_testcase/2</c>. <c>fin_per_testcase</c> is kept
- for backwards compatibility.</p>
- <p>Added support for writing own test server frameworks.
- Callback functions <c>init_tc/1</c>, <c>end_tc/3</c>,
- <c>get_suite/2</c>, <c>report/2</c>, <c>warn/1</c>.</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Test Server 3.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Added the options <c>cover</c> and <c>cover_details</c>
- to <c>ts:run</c>. When one of these options is used,
- the tested application will be cover compiled
- before the test is run. The cover compiled code will also
- be loaded on all slave or peer nodes started with
- <c>test_server:start_node</c>. When the test is completed
- coverage data from all nodes is collected and merged, and
- presented in the coverage log to which there will be a link
- from the test suite result page (i.e. the one with the
- heading "Test suite ... results").</p>
- <p>The <c>cover_details</c> option will do
- <c>cover:analyse_to_file</c> for each cover compiled module,
- while the <c>cover</c> option only will produce a list of
- modules and the number of covered/uncovered lines in each
- module.</p>
- <p>To make it possible to run all test from a script (like in
- the OTP daily builds), the following is added:
- <c>ts:run([all_tests | Options])</c>.</p>
- <p>This means that e.g. the following is possible:
- <c>erl -s ts run all_tests batch cover</c>.</p>
- <p>Note that it is also possible to run tests with cover even
- if you don't use <c>ts</c>.
- See <c>test_server_ctrl:cover/2/3</c>.</p>
- <p>Own Id: OTP-4703</p>
- </item>
- <item>
- <p>Removed module <c>ts_save.erl</c> and function
- <c>ts:save/0/1</c><em>(incompatible)</em>.</p>
- <p>Added config variable <c>ipv6_hosts</c> to
- <c>ts:install/1</c> and test spec file.</p>
- <p>No longer removing duplicates of test cases from test spec
- <em>(incompatible)</em>.</p>
- <p>Added function <c>test_server:run_on_shielded_node/2</c>.</p>
- <p>Creation of html files for test suite source does no longer
- crash if suite contains more than 9999 lines of code.</p>
- <p>Added functionality for cross cover compilation,
- i.e. collection of cover data from all tests.</p>
- <p>Multiplying timetrap times with 10 when running with cover.</p>
- <p>Added <c>ts:r/3</c> for running tests with cover.</p>
- <p>*** POTENTIAL INCOMPATIBILITY ***</p>
- <p>Own Id: OTP-5040</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/test_server/doc/src/part.xml b/lib/test_server/doc/src/part.xml
deleted file mode 100644
index 685ed16a94..0000000000
--- a/lib/test_server/doc/src/part.xml
+++ /dev/null
@@ -1,46 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Test Server User's Guide</title>
- <prepared></prepared>
- <docno></docno>
- <date>2002-07-11</date>
- <rev></rev>
- </header>
- <description>
- <p><em>Test Server</em> is a portable test server for
- automated application testing. The server can run test suites
- and log progress and results to HTML
- pages. The main purpose of Test Server is to act as engine
- inside customized test tools. A callback interface for
- such framework applications is provided.</p>
- </description>
- <xi:include href="basics_chapter.xml"/>
- <xi:include href="test_spec_chapter.xml"/>
- <xi:include href="write_test_chapter.xml"/>
- <xi:include href="run_test_chapter.xml"/>
- <xi:include href="write_framework_chapter.xml"/>
- <xi:include href="example_chapter.xml"/>
-</part>
-
diff --git a/lib/test_server/doc/src/part_notes.xml b/lib/test_server/doc/src/part_notes.xml
deleted file mode 100644
index 8cb9b6c591..0000000000
--- a/lib/test_server/doc/src/part_notes.xml
+++ /dev/null
@@ -1,41 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>2004</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Test Server Release Notes</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <description>
- <p>The <em>Test Server</em> is a portable test server for
- application testing. The test server can run automatic test suites
- and log progress and results to HTML
- pages. It also provides some support for test suite authors.</p>
- <p>For information about older versions, see
- <url href="part_notes_history_frame.html">Release Notes History</url>.</p>
- </description>
- <xi:include href="notes.xml"/>
-</part>
-
diff --git a/lib/test_server/doc/src/part_notes_history.xml b/lib/test_server/doc/src/part_notes_history.xml
deleted file mode 100644
index 468b5aa8ba..0000000000
--- a/lib/test_server/doc/src/part_notes_history.xml
+++ /dev/null
@@ -1,39 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part>
- <header>
- <copyright>
- <year>2006</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Test Server Release Notes History</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <description>
- <p>The <em>Test Server</em> is a portable test server for
- application testing. The test server can run automatic test suites
- and log progress and results to HTML
- pages. It also provides some support for test suite authors.</p>
- </description>
- <include file="notes_history"></include>
-</part>
-
diff --git a/lib/test_server/doc/src/ref_man.xml b/lib/test_server/doc/src/ref_man.xml
deleted file mode 100644
index 1b06d9750b..0000000000
--- a/lib/test_server/doc/src/ref_man.xml
+++ /dev/null
@@ -1,44 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE application SYSTEM "application.dtd">
-
-<application xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Test Server Reference Manual</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>ref_man.xml</file>
- </header>
- <description>
- <p><em>Test Server</em> is a portable test server for
- automated application testing. The server can run test suites
- and log progress and results to HTML
- pages. The main purpose of Test Server is to act as engine
- inside customized test tools. A callback interface for
- such framework applications is provided.</p>
- </description>
- <xi:include href="test_server_app.xml"/>
- <xi:include href="test_server_ctrl.xml"/>
- <xi:include href="test_server.xml"/>
-</application>
-
diff --git a/lib/test_server/doc/src/run_test_chapter.xml b/lib/test_server/doc/src/run_test_chapter.xml
deleted file mode 100644
index cb5b29c993..0000000000
--- a/lib/test_server/doc/src/run_test_chapter.xml
+++ /dev/null
@@ -1,50 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Running Test Suites</title>
- <prepared>Siri Hansen</prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>run_test_chapter.xml</file>
- </header>
-
- <section>
- <title>Using the test server controller</title>
- <p>The test server controller provides a low level interface to
- all the Test Server functionality. It is possible to use this
- interface directly, but it is recommended to use a framework
- such as <em>Common Test</em> instead. If no existing framework
- suits your needs, you could of course build your own
- on top of the test server controller. Some information about how
- to do this can be found in the section named "Writing you own
- test server framework" in the Test Server User's Guide.
- </p>
- <p>For information about using the controller directly, please see
- all available functions in the reference manual for
- <c>test_server_ctrl</c>.
- </p>
- </section>
-</chapter>
-
diff --git a/lib/test_server/doc/src/test_server.xml b/lib/test_server/doc/src/test_server.xml
deleted file mode 100644
index 96ff6de3ba..0000000000
--- a/lib/test_server/doc/src/test_server.xml
+++ /dev/null
@@ -1,853 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2007</year>
- <year>2013</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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.
- </legalnotice>
-
- <title>test_server</title>
- <prepared>Siri Hansen</prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date></date>
- <rev></rev>
- <file>test_server_ref.sgml</file>
- </header>
- <module>test_server</module>
- <modulesummary>This module provides support for test suite authors.</modulesummary>
- <description>
- <p>The <c>test_server</c> module aids the test suite author by providing
- various support functions. The supported functionality includes:
- </p>
- <list type="bulleted">
- <item>Logging and timestamping
- </item>
- <item>Capturing output to stdout
- </item>
- <item>Retrieving and flushing the message queue of a process
- </item>
- <item>Watchdog timers, process sleep, time measurement and unit
- conversion
- </item>
- <item>Private scratch directory for all test suites
- </item>
- <item>Start and stop of slave- or peer nodes</item>
- </list>
- <p>For more information on how to write test cases and for
- examples, please see the Test Server User's Guide.
- </p>
- </description>
-
- <section>
- <title>TEST SUITE SUPPORT FUNCTIONS</title>
- <p>The following functions are supposed to be used inside a test
- suite.
- </p>
- </section>
- <funcs>
- <func>
- <name>os_type() -> OSType</name>
- <fsummary>Returns the OS type of the target node</fsummary>
- <type>
- <v>OSType = term()</v>
- <d>This is the same as returned from <c>os:type/0</c></d>
- </type>
- <desc>
- <p>This function is equivalent to <c>os:type/0</c>. It is kept
- for backwards compatibility.</p>
- </desc>
- </func>
- <func>
- <name>fail()</name>
- <name>fail(Reason)</name>
- <fsummary>Makes the test case fail.</fsummary>
- <type>
- <v>Reason = term()</v>
- <d>The reason why the test case failed.</d>
- </type>
- <desc>
- <p>This will make the test suite fail with a given reason, or
- with <c>suite_failed</c> if no reason was given. Use this
- function if you want to terminate a test case, as this will
- make it easier to read the log- and HTML files. <c>Reason</c>
- will appear in the comment field in the HTML log.</p>
- </desc>
- </func>
- <func>
- <name>timetrap(Timout) -> Handle</name>
- <fsummary></fsummary>
- <type>
- <v>Timeout = integer() | {hours,H} | {minutes,M} | {seconds,S}</v>
- <v>H = M = S = integer()</v>
- <v>Pid = pid()</v>
- <d>The process that is to be timetrapped (<c>self()</c>by default)</d>
- </type>
- <desc>
- <p>Sets up a time trap for the current process. An expired
- timetrap kills the process with reason
- <c>timetrap_timeout</c>. The returned handle is to be given
- as argument to <c>timetrap_cancel</c> before the timetrap
- expires. If <c>Timeout</c> is an integer, it is expected to
- be milliseconds.</p>
- <note>
- <p>If the current process is trapping exits, it will not be killed
- by the exit signal with reason <c>timetrap_timeout</c>.
- If this happens, the process will be sent an exit signal
- with reason <c>kill</c> 10 seconds later which will kill the
- process. Information about the timetrap timeout will in
- this case not be found in the test logs. However, the
- error_logger will be sent a warning.</p>
- </note>
- </desc>
- </func>
- <func>
- <name>timetrap_cancel(Handle) -> ok</name>
- <fsummary>Cancels a timetrap.</fsummary>
- <type>
- <v>Handle = term()</v>
- <d>Handle returned from <c>timetrap</c></d>
- </type>
- <desc>
- <p>This function cancels a timetrap. This must be done before
- the timetrap expires.</p>
- </desc>
- </func>
- <func>
- <name>timetrap_scale_factor() -> ScaleFactor</name>
- <fsummary>Returns the scale factor for timeouts.</fsummary>
- <type>
- <v>ScaleFactor = integer()</v>
- </type>
- <desc>
- <p>This function returns the scale factor by which all timetraps
- are scaled. It is normally 1, but can be greater than 1 if
- the test_server is running <c>cover</c>, using a larger amount of
- scheduler threads than the amount of logical processors on the
- system, running under purify, valgrind or in a debug-compiled
- emulator. The scale factor can be used if you need to scale you
- own timeouts in test cases with same factor as the test_server
- uses.</p>
- </desc>
- </func>
- <func>
- <name>sleep(MSecs) -> ok</name>
- <fsummary>Suspens the calling task for a specified time.</fsummary>
- <type>
- <v>MSecs = integer() | float() | infinity</v>
- <d>The number of milliseconds to sleep</d>
- </type>
- <desc>
- <p>This function suspends the calling process for at least the
- supplied number of milliseconds. There are two major reasons
- why you should use this function instead of
- <c>timer:sleep</c>, the first being that the module
- <c>timer</c> may be unavailable at the time the test suite is
- run, and the second that it also accepts floating point
- numbers.</p>
- </desc>
- </func>
- <func>
- <name>adjusted_sleep(MSecs) -> ok</name>
- <fsummary>Suspens the calling task for a specified time.</fsummary>
- <type>
- <v>MSecs = integer() | float() | infinity</v>
- <d>The default number of milliseconds to sleep</d>
- </type>
- <desc>
- <p>This function suspends the calling process for at least the
- supplied number of milliseconds. The function behaves the same
- way as <c>test_server:sleep/1</c>, only <c>MSecs</c>
- will be multiplied by the 'multiply_timetraps' value, if set,
- and also automatically scaled up if 'scale_timetraps' is set
- to true (which it is by default).</p>
- </desc>
- </func>
- <func>
- <name>hours(N) -> MSecs</name>
- <name>minutes(N) -> MSecs</name>
- <name>seconds(N) -> MSecs</name>
- <fsummary></fsummary>
- <type>
- <v>N = integer()</v>
- <d>Value to convert to milliseconds.</d>
- </type>
- <desc>
- <p>Theese functions convert <c>N</c> number of hours, minutes
- or seconds into milliseconds.
- </p>
- <p>Use this function when you want to
- <c>test_server:sleep/1</c> for a number of seconds, minutes or
- hours(!).</p>
- </desc>
- </func>
- <func>
- <name>format(Format) -> ok</name>
- <name>format(Format, Args)</name>
- <name>format(Pri, Format)</name>
- <name>format(Pri, Format, Args)</name>
- <fsummary></fsummary>
- <type>
- <v>Format = string()</v>
- <d>Format as described for <c>io_:format</c>.</d>
- <v>Args = list()</v>
- <d>List of arguments to format.</d>
- </type>
- <desc>
- <p>Formats output just like <c>io:format</c> but sends the
- formatted string to a logfile. If the urgency value,
- <c>Pri</c>, is lower than some threshold value, it will also
- be written to the test person's console. Default urgency is
- 50, default threshold for display on the console is 1.
- </p>
- <p>Typically, the test person don't want to see everything a
- test suite outputs, but is merely interested in if the test
- cases succeeded or not, which the test server tells him. If he
- would like to see more, he could manually change the threshold
- values by using the <c>test_server_ctrl:set_levels/3</c>
- function.</p>
- </desc>
- </func>
- <func>
- <name>capture_start() -> ok</name>
- <name>capture_stop() -> ok</name>
- <name>capture_get() -> list()</name>
- <fsummary>Captures all output to stdout for a process.</fsummary>
- <desc>
- <p>These functions makes it possible to capture all output to
- stdout from a process started by the test suite. The list of
- characters captured can be purged by using <c>capture_get</c>.</p>
- </desc>
- </func>
- <func>
- <name>messages_get() -> list()</name>
- <fsummary>Empty the message queue.</fsummary>
- <desc>
- <p>This function will empty and return all the messages
- currently in the calling process' message queue.</p>
- </desc>
- </func>
- <func>
- <name>timecall(M, F, A) -> {Time, Value}</name>
- <fsummary>Measures the time needed to call a function.</fsummary>
- <type>
- <v>M = atom()</v>
- <d>The name of the module where the function resides.</d>
- <v>F = atom()</v>
- <d>The name of the function to call in the module.</d>
- <v>A = list()</v>
- <d>The arguments to supply the called function.</d>
- <v>Time = integer()</v>
- <d>The number of seconds it took to call the function.</d>
- <v>Value = term()</v>
- <d>Value returned from the called function.</d>
- </type>
- <desc>
- <p>This function measures the time (in seconds) it takes to
- call a certain function. The function call is <em>not</em>
- caught within a catch.</p>
- </desc>
- </func>
- <func>
- <name>do_times(N, M, F, A) -> ok</name>
- <name>do_times(N, Fun)</name>
- <fsummary>Calls MFA or Fun N times.</fsummary>
- <type>
- <v>N = integer()</v>
- <d>Number of times to call MFA.</d>
- <v>M = atom()</v>
- <d>Module name where the function resides.</d>
- <v>F = atom()</v>
- <d>Function name to call.</d>
- <v>A = list()</v>
- <d>Arguments to M:F.</d>
- </type>
- <desc>
- <p>Calls MFA or Fun N times. Useful for extensive testing of a
- sensitive function.</p>
- </desc>
- </func>
- <func>
- <name>m_out_of_n(M, N, Fun) -> ok | exit({m_out_of_n_failed, {R,left_to_do}}</name>
- <fsummary>Fault tolerant <c>do_times</c>.</fsummary>
- <type>
- <v>N = integer()</v>
- <d>Number of times to call the Fun.</d>
- <v>M = integer()</v>
- <d>Number of times to require a successful return.</d>
- </type>
- <desc>
- <p>Repeatedly evaluates the given function until it succeeds
- (doesn't crash) M times. If, after N times, M successful
- attempts have not been accomplished, the process crashes with
- reason {m_out_of_n_failed, {R,left_to_do}}, where R indicates
- how many cases that was still to be successfully completed.
- </p>
- <p>For example:
- </p>
- <p><c>m_out_of_n(1,4,fun() -> tricky_test_case() end)</c> <br></br>
-Tries to run tricky_test_case() up to 4 times, and is
- happy if it succeeds once.
- </p>
- <p><c>m_out_of_n(7,8,fun() -> clock_sanity_check() end)</c> <br></br>
-Tries running clock_sanity_check() up to 8 times,and
- allows the function to fail once. This might be useful if
- clock_sanity_check/0 is known to fail if the clock crosses an
- hour boundary during the test (and the up to 8 test runs could
- never cross 2 boundaries)</p>
- </desc>
- </func>
- <func>
- <name>call_crash(M, F, A) -> Result</name>
- <name>call_crash(Time, M, F, A) -> Result</name>
- <name>call_crash(Time, Crash, M, F, A) -> Result</name>
- <fsummary>Calls MFA and succeeds if it crashes.</fsummary>
- <type>
- <v>Result = ok | exit(call_crash_timeout) | exit({wrong_crash_reason, Reason})</v>
- <v>Crash = term()</v>
- <d>Crash return from the function.</d>
- <v>Time = integer()</v>
- <d>Timeout in milliseconds.</d>
- <v>M = atom()</v>
- <d>Module name where the function resides.</d>
- <v>F = atom()</v>
- <d>Function name to call.</d>
- <v>A = list()</v>
- <d>Arguments to M:F.</d>
- </type>
- <desc>
- <p>Spawns a new process that calls MFA. The call is considered
- successful if the call crashes with the gives reason
- (<c>Crash</c>) or any reason if not specified. The call must
- terminate within the given time (default <c>infinity</c>), or
- it is considered a failure.</p>
- </desc>
- </func>
- <func>
- <name>temp_name(Stem) -> Name</name>
- <fsummary>Returns a unique filename.</fsummary>
- <type>
- <v>Stem = string()</v>
- </type>
- <desc>
- <p>Returns a unique filename starting with <c>Stem</c> with
- enough extra characters appended to make up a unique
- filename. The filename returned is guaranteed not to exist in
- the filesystem at the time of the call.</p>
- </desc>
- </func>
- <func>
- <name>break(Comment) -> ok</name>
- <fsummary>Cancel all timetraps and wait for call to continue/0.</fsummary>
- <type>
- <v>Comment = string()</v>
- </type>
- <desc>
- <p><c>Comment</c> is a string which will be written in
- the shell, e.g. explaining what to do.</p>
- <p>This function will cancel all timetraps and pause the
- execution of the test case until the user executes the
- <c>continue/0</c> function. It gives the user the opportunity
- to interact with the erlang node running the tests, e.g. for
- debugging purposes or for manually executing a part of the
- test case.</p>
- <p>When the <c>break/1</c> function is called, the shell will
- look something like this:</p>
- <code type="none"><![CDATA[
- --- SEMIAUTOMATIC TESTING ---
- The test case executes on process <0.51.0>
-
-
- "Here is a comment, it could e.g. instruct to pull out a card"
-
-
- -----------------------------
-
- Continue with --> test_server:continue(). ]]></code>
- <p>The user can now interact with the erlang node, and when
- ready call <c>test_server:continue().</c></p>
- <p>Note that this function can not be used if the test is
- executed with <c>ts:run/0/1/2/3/4</c> in <c>batch</c> mode.</p>
- </desc>
- </func>
- <func>
- <name>continue() -> ok</name>
- <fsummary>Continue after break/1.</fsummary>
- <desc>
- <p>This function must be called in order to continue after a
- test case has called <c>break/1</c>.</p>
- </desc>
- </func>
- <func>
- <name>run_on_shielded_node(Fun, CArgs) -> term()</name>
- <fsummary>Execute a function a shielded node.</fsummary>
- <type>
- <v>Fun = function() (arity 0)</v>
- <d>Function to execute on the shielded node.</d>
- <v>CArg = string()</v>
- <d>Extra command line arguments to use when starting the shielded node.</d>
- </type>
- <desc>
- <p><c>Fun</c> is executed in a process on a temporarily created
- hidden node with a proxy for communication with the test server
- node. The node is called a shielded node (should have been called
- a shield node). If <c>Fun</c> is successfully executed, the result
- is returned. A peer node (see <c>start_node/3</c>) started from
- the shielded node will be shielded from test server node, i.e.
- they will not be aware of each other. This is useful when you want
- to start nodes from earlier OTP releases than the OTP release of
- the test server node.</p>
- <p>Nodes from an earlier OTP release can normally not be started
- if the test server hasn't been started in compatibility mode
- (see the <c>+R</c> flag in the <c>erl(1)</c> documentation) of
- an earlier release. If a shielded node is started in compatibility
- mode of an earlier OTP release than the OTP release of the test
- server node, the shielded node can start nodes of an earlier OTP
- release.</p>
- <note>
- <p>You <em>must</em> make sure that nodes started by the shielded
- node never communicate directly with the test server node.</p>
- </note>
- <note>
- <p>Slave nodes always communicate with the test server node;
- therefore, <em>never</em> start <em>slave nodes</em> from the
- shielded node, <em>always</em> start <em>peer nodes</em>.</p>
- </note>
- </desc>
- </func>
- <func>
- <name>start_node(Name, Type, Options) -> {ok, Node} | {error, Reason}</name>
- <fsummary>Start a node.</fsummary>
- <type>
- <v>Name = atom() | string()</v>
- <d>Name of the slavenode to start (as given to -sname or -name)</d>
- <v>Type = slave | peer</v>
- <d>The type of node to start.</d>
- <v>Options = [{atom(), term()]</v>
- <d>Tuplelist of options</d>
- </type>
- <desc>
- <p>This functions starts a node, possibly on a remote machine,
- and guarantees cross architecture transparency. Type is set to
- either <c>slave</c> or <c>peer</c>.
- </p>
- <p><c>slave</c> means that the new node will have a master,
- i.e. the slave node will terminate if the master terminates,
- TTY output produced on the slave will be sent back to the
- master node and file I/O is done via the master. The master is
- normally the target node unless the target is itself a slave.
- </p>
- <p><c>peer</c> means that the new node is an independent node
- with no master.
- </p>
- <p><c>Options</c> is a tuplelist which can contain one or more
- of
- </p>
- <taglist>
- <tag><c>{remote, true}</c></tag>
- <item>Start the node on a remote host. If not specified, the
- node will be started on the local host. Test cases that
- require a remote host will fail with a reasonable comment if
- no remote hosts are available at the time they are run.
- </item>
- <tag><c>{args, Arguments}</c></tag>
- <item>Arguments passed directly to the node. This is
- typically a string appended to the command line.
- </item>
- <tag><c>{wait, false}</c></tag>
- <item>Don't wait until the node is up. By default, this
- function does not return until the node is up and running,
- but this option makes it return as soon as the node start
- command is given..
- <br></br>
-Only valid for peer nodes
- </item>
- <tag><c>{fail_on_error, false}</c></tag>
- <item>Returns <c>{error, Reason}</c> rather than failing the
- test case.
- <br></br>
-Only valid for peer nodes. Note that slave nodes always
- act as if they had <c>fail_on_error=false</c></item>
- <tag><c>{erl, ReleaseList}</c></tag>
- <item>Use an Erlang emulator determined by ReleaseList when
- starting nodes, instead of the same emulator as the test
- server is running. ReleaseList is a list of specifiers,
- where a specifier is either {release, Rel}, {prog, Prog}, or
- 'this'. Rel is either the name of a release, e.g., "r12b_patched"
- or 'latest'. 'this' means using the same emulator as the test
- server. Prog is the name of an emulator executable. If the
- list has more than one element, one of them is picked
- randomly. (Only works on Solaris and Linux, and the test server
- gives warnings when it notices that nodes are not of the same
- version as itself.)
- <br></br>
- <br></br>
-
- When specifying this option to run a previous release, use
- <c>is_release_available/1</c> function to test if the given
- release is available and skip the test case if not.
- <br></br>
- <br></br>
-
- In order to avoid compatibility problems (may not appear right
- away), use a shielded node (see <c>run_on_shielded_node/2</c>)
- when starting nodes from different OTP releases than the test
- server.
- </item>
- <tag><c>{cleanup, false}</c></tag>
- <item>Tells the test server not to kill this node if it is
- still alive after the test case is completed. This is useful
- if the same node is to be used by a group of test cases.
- </item>
- <tag><c>{env, Env}</c></tag>
- <item><c>Env</c> should be a list of tuples <c>{Name, Val}</c>,
- where <c>Name</c> is the name of an environment variable, and
- <c>Val</c> is the value it is to have in the started node.
- Both <c>Name</c> and <c>Val</c> must be strings. The one
- exception is <c>Val</c> being the atom <c>false</c> (in
- analogy with <c>os:getenv/1</c>), which removes the
- environment variable. Only valid for peer nodes. Not
- available on VxWorks.</item>
- <tag><c>{start_cover, false}</c></tag>
- <item>By default the test server will start cover on all nodes
- when the test is run with code coverage analysis. To make
- sure cover is not started on a new node, set this option to
- <c>false</c>. This can be necessary if the connection to
- the node at some point will be broken but the node is
- expected to stay alive. The reason is that a remote cover
- node can not continue to run without its main node. Another
- solution would be to explicitly stop cover on the node
- before breaking the connection, but in some situations (if
- old code resides in one or more processes) this is not
- possible.</item>
- </taglist>
- </desc>
- </func>
- <func>
- <name>stop_node(NodeName) -> bool()</name>
- <fsummary>Stops a node</fsummary>
- <type>
- <v>NodeName = term()</v>
- <d>Name of the node to stop</d>
- </type>
- <desc>
- <p>This functions stops a node previously started with
- <c>start_node/3</c>. Use this function to stop any node you
- start, or the test server will produce a warning message in
- the test logs, and kill the nodes automatically unless it was
- started with the <c>{cleanup, false}</c> option.</p>
- </desc>
- </func>
- <func>
- <name>is_commercial() -> bool()</name>
- <fsummary>Tests whether the emulator is commercially supported</fsummary>
- <desc>
- <p>This function test whether the emulator is commercially supported
- emulator. The tests for a commercially supported emulator could be more
- stringent (for instance, a commercial release should always contain
- documentation for all applications).</p>
- </desc>
- </func>
-
- <func>
- <name>is_release_available(Release) -> bool()</name>
- <fsummary>Tests whether a release is available</fsummary>
- <type>
- <v>Release = string() | atom()</v>
- <d>Release to test for</d>
- </type>
- <desc>
- <p>This function test whether the release given by
- <c>Release</c> (for instance, "r12b_patched") is available
- on the computer that the test_server controller is running on.
- Typically, you should skip the test case if not.</p>
- <p>Caution: This function may not be called from the <c>suite</c>
- clause of a test case, as the test_server will deadlock.</p>
- </desc>
- </func>
- <func>
- <name>is_native(Mod) -> bool()</name>
- <fsummary>Checks whether the module is natively compiled or not</fsummary>
- <type>
- <v>Mod = atom()</v>
- <d>A module name</d>
- </type>
- <desc>
- <p>Checks whether the module is natively compiled or not</p>
- </desc>
- </func>
- <func>
- <name>app_test(App) -> ok | test_server:fail()</name>
- <name>app_test(App,Mode)</name>
- <fsummary>Checks an applications .app file for obvious errors</fsummary>
- <type>
- <v>App = term()</v>
- <d>The name of the application to test</d>
- <v>Mode = pedantic | tolerant</v>
- <d>Default is pedantic</d>
- </type>
- <desc>
- <p>Checks an applications .app file for obvious errors.
- The following is checked:
- </p>
- <list type="bulleted">
- <item>required fields
- </item>
- <item>that all modules specified actually exists
- </item>
- <item>that all requires applications exists
- </item>
- <item>that no module included in the application has export_all
- </item>
- <item>that all modules in the ebin/ dir is included (If
- <c>Mode==tolerant</c> this only produces a warning, as all
- modules does not have to be included)</item>
- </list>
- </desc>
- </func>
- <func>
- <name>appup_test(App) -> ok | test_server:fail()</name>
- <fsummary>Checks an applications .appup file for obvious errors</fsummary>
- <type>
- <v>App = term()</v>
- <d>The name of the application to test</d>
- </type>
- <desc>
- <p>Checks an applications .appup file for obvious errors.
- The following is checked:
- </p>
- <list type="bulleted">
- <item>syntax
- </item>
- <item>that .app file version and .appup file version match
- </item>
- <item>for non-library applications: validity of high-level upgrade
- instructions, specifying no instructions is explicitly allowed
- (in this case the application is not upgradeable)</item>
- <item>for library applications: that there is exactly one wildcard
- regexp clause restarting the application when upgrading or
- downgrading from any version</item>
- </list>
- </desc>
- </func>
- <func>
- <name>comment(Comment) -> ok</name>
- <fsummary>Print a comment on the HTML result page</fsummary>
- <type>
- <v>Comment = string()</v>
- </type>
- <desc>
- <p>The given String will occur in the comment field of the
- table on the HTML result page. If called several times, only
- the last comment is printed. comment/1 is also overwritten by
- the return value {comment,Comment} from a test case or by
- fail/1 (which prints Reason as a comment).</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>TEST SUITE EXPORTS</title>
- <p>The following functions must be exported from a test suite
- module.
- </p>
- </section>
- <funcs>
- <func>
- <name>all(suite) -> TestSpec | {skip, Comment}</name>
- <fsummary>Returns the module's test specification</fsummary>
- <type>
- <v>TestSpec = list()</v>
- <v>Comment = string()</v>
- <d>This comment will be printed on the HTML result page</d>
- </type>
- <desc>
- <p>This function must return the test specification for the
- test suite module. The syntax of a test specification is
- described in the Test Server User's Guide.</p>
- </desc>
- </func>
- <func>
- <name>init_per_suite(Config0) -> Config1 | {skip, Comment}</name>
- <fsummary>Test suite initiation</fsummary>
- <type>
- <v>Config0 = Config1 = [tuple()]</v>
- <v>Comment = string()</v>
- <d>Describes why the suite is skipped</d>
- </type>
- <desc>
- <p>This function is called before all other test cases in the
- suite. <c>Config</c> is the configuration which can be modified
- here. Whatever is returned from this function is given as
- <c>Config</c> to the test cases.
- </p>
- <p>If this function fails, all test cases in the suite will be
- skipped.</p>
- </desc>
- </func>
- <func>
- <name>end_per_suite(Config) -> void()</name>
- <fsummary>Test suite finalization</fsummary>
- <type>
- <v>Config = [tuple()]</v>
- </type>
- <desc>
- <p>This function is called after the last test case in the
- suite, and can be used to clean up whatever the test cases
- have done. The return value is ignored.</p>
- </desc>
- </func>
- <func>
- <name>init_per_testcase(Case, Config0) -> Config1 | {skip, Comment}</name>
- <fsummary>Test case initiation</fsummary>
- <type>
- <v>Case = atom()</v>
- <v>Config0 = Config1 = [tuple()]</v>
- <v>Comment = string()</v>
- <d>Describes why the test case is skipped</d>
- </type>
- <desc>
- <p>This function is called before each test case. The
- <c>Case</c> argument is the name of the test case, and
- <c>Config</c> is the configuration which can be modified
- here. Whatever is returned from this function is given as
- <c>Config</c> to the test case.</p>
- </desc>
- </func>
- <func>
- <name>end_per_testcase(Case, Config) -> void()</name>
- <fsummary>Test case finalization</fsummary>
- <type>
- <v>Case = atom()</v>
- <v>Config = [tuple()]</v>
- </type>
- <desc>
- <p>This function is called after each test case, and can be
- used to clean up whatever the test case has done. The return
- value is ignored.</p>
- </desc>
- </func>
- <func>
- <name>Case(doc) -> [Decription]</name>
- <name>Case(suite) -> [] | TestSpec | {skip, Comment}</name>
- <name>Case(Config) -> {skip, Comment} | {comment, Comment} | Ok</name>
- <fsummary>A test case</fsummary>
- <type>
- <v>Description = string()</v>
- <d>Short description of the test case</d>
- <v>TestSpec = list()</v>
- <v>Comment = string()</v>
- <d>This comment will be printed on the HTML result page</d>
- <v>Ok = term()</v>
- <v>Config = [tuple()]</v>
- <d>Elements from the Config parameter can be read with the ?config macro, see section about test suite support macros</d>
- </type>
- <desc>
- <p>The <em>documentation clause</em> (argument <c>doc</c>) can
- be used for automatic generation of test documentation or test
- descriptions.
- </p>
- <p>The <em>specification clause</em> (argument <c>spec</c>)
- shall return an empty list, the test specification for the
- test case or <c>{skip,Comment}</c>. The syntax of a test
- specification is described in the Test Server User's Guide.
- </p>
- <p>The <em>execution clause</em> (argument <c>Config</c>) is
- only called if the specification clause returns an empty list.
- The execution clause is the real test case. Here you must call
- the functions you want to test, and do whatever you need to
- check the result. If something fails, make sure the process
- crashes or call <c>test_server:fail/0/1</c> (which also will
- cause the process to crash).
- </p>
- <p>You can return <c>{skip,Comment}</c> if you decide not to
- run the test case after all, e.g. if it is not applicable on
- this platform.
- </p>
- <p>You can return <c>{comment,Comment}</c> if you wish to
- print some information in the 'Comment' field on the HTML
- result page.
- </p>
- <p>If the execution clause returns anything else, it is
- considered a success, unless it is <c>{'EXIT',Reason}</c> or
- <c>{'EXIT',Pid,Reason}</c> which can't be distinguished from a
- crash, and thus will be considered a failure.
- </p>
- <p>A <em>conf test case</em> is a group of test cases with an
- init and a cleanup function. The init and cleanup functions
- are also test cases, but they have special rules:</p>
- <list type="bulleted">
- <item>They do not need a specification clause.</item>
- <item>They must always have the execution clause.</item>
- <item>They must return the <c>Config</c> parameter, a modified
- version of it or <c>{skip,Comment}</c> from the execution clause.</item>
- <item>The cleanup function may also return a tuple
- <c>{return_group_result,Status}</c>, which is used to return the
- status of the conf case to Test Server and/or to a conf case on a
- higher level. (<c>Status = ok | skipped | failed</c>).</item>
- <item><c>init_per_testcase</c> and <c>end_per_testcase</c> are
- not called before and after these functions.</item>
- </list>
- </desc>
- </func>
- </funcs>
-
-
- <section>
- <title>TEST SUITE SUPPORT MACROS</title>
- <p>There are some macros defined in the <c>test_server.hrl</c>
- that are quite useful for test suite programmers:
- </p>
- <p>The <em>config</em> macro, is used to
- retrieve information from the <c>Config</c> variable sent to all
- test cases. It is used with two arguments, where the first is the
- name of the configuration variable you wish to retrieve, and the
- second is the <c>Config</c> variable supplied to the test case
- from the test server.
- </p>
- <p>Possible configuration variables include:</p>
- <list type="bulleted">
- <item><c>data_dir</c> - Data file directory.</item>
- <item><c>priv_dir</c> - Scratch file directory.</item>
- <item><c>nodes</c> - Nodes specified in the spec file</item>
- <item><c>nodenames</c> - Generated nodenames.</item>
- <item>Whatever added by conf test cases or
- <c>init_per_testcase/2</c></item>
- </list>
- <p>Examples of the <c>config</c> macro can be seen in the Examples chapter
- in the user's guide.</p>
- <p>The <em>line</em> and <em>line_trace</em> macros are deprecated, see
- below.</p>
- </section>
-
- <section>
- <title>TEST SUITE LINE NUMBERS</title>
- <p>In the past, ERTS did not produce line numbers when generating
- stacktraces, test_server was thus unable to provide them when reporting
- test failures. It had instead two different mecanisms to do it: either by
- using the <c>line</c> macro or by using the <c>test_server_line</c> parse
- transform. Both are deprecated and should not be used in new tests
- anymore.</p>
- </section>
-</erlref>
-
diff --git a/lib/test_server/doc/src/test_server_app.xml b/lib/test_server/doc/src/test_server_app.xml
deleted file mode 100644
index 4830916561..0000000000
--- a/lib/test_server/doc/src/test_server_app.xml
+++ /dev/null
@@ -1,75 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE appref SYSTEM "appref.dtd">
-
-<appref>
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Test Server Application</title>
- <prepared>Siri Hansen</prepared>
- <responsible>Peter Andersson</responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2002-07-12</date>
- <rev>PA1</rev>
- <file>test_server_app.xml</file>
- </header>
- <app>test_server</app>
- <appsummary>Test Server for manual or automatic testing of Erlang code</appsummary>
- <description>
- <p><em>Test Server</em> is a portable test server for
- automated application testing. The server can run test suites
- and log progress and results to HTML
- pages. The main purpose of Test Server is to act as engine
- inside customized test tools. A callback interface for
- such framework applications is provided.</p>
- <p>In brief the test server supports:</p>
- <list type="bulleted">
- <item>Running multiple, concurrent test suites</item>
- <item>Test suites may contain other test suites, in a tree fashion</item>
- <item>Logging of the events in a test suite, on both suite and case levels</item>
- <item>HTML presentation of test suite results</item>
- <item>HTML presentation of test suite code</item>
- <item>Support for test suite authors, e.g. start/stop slave nodes</item>
- <item>Call trace on target and slave nodes</item>
- </list>
- <p>For information about how to write test cases and test suites,
- please see the Test Server User's Guide and the reference
- manual for the <c>test_server</c> module.
- </p>
- <p><em>Common Test</em> is an existing test tool application based on the
- OTP Test Server. Please read the Common Test User's Guide for more information.
- </p>
- </description>
-
- <section>
- <title>Configuration</title>
- <p>There are currently no configuration parameters available for
- this application.
- </p>
- </section>
-
- <section>
- <title>SEE ALSO</title>
- <p></p>
- </section>
-</appref>
-
diff --git a/lib/test_server/doc/src/test_server_ctrl.xml b/lib/test_server/doc/src/test_server_ctrl.xml
deleted file mode 100644
index 2762997ece..0000000000
--- a/lib/test_server/doc/src/test_server_ctrl.xml
+++ /dev/null
@@ -1,844 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2007</year>
- <year>2013</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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.
- </legalnotice>
-
- <title>The Test Server Controller</title>
- <prepared>Siri Hansen, Peter Andersson</prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date></date>
- <rev></rev>
- <file>test_server_ctrl_ref.sgml</file>
- </header>
- <module>test_server_ctrl</module>
- <modulesummary>This module provides a low level interface to the Test Server.</modulesummary>
- <description>
- <p>The <c>test_server_ctrl</c> module provides a low level
- interface to the Test Server. This interface is normally
- not used directly by the tester, but through a framework built
- on top of <c>test_server_ctrl</c>.
- </p>
- <p>Common Test is such a framework, well suited for automated
- black box testing of target systems of any kind (not necessarily
- implemented in Erlang). Common Test is also a very useful tool for
- white box testing Erlang programs and OTP applications.
- Please see the Common Test User's Guide and reference manual for
- more information.
- </p>
- <p>If you want to write your own framework, some more information
- can be found in the chapter "Writing your own test server
- framework" in the Test Server User's Guide. Details about the
- interface provided by <c>test_server_ctrl</c> follows below.
- </p>
- </description>
- <funcs>
- <func>
- <name>start() -> Result</name>
- <fsummary>Starts the test server.</fsummary>
- <type>
- <v>Result = ok | {error, {already_started, pid()}</v>
- </type>
- <desc>
- <p>This function starts the test server.</p>
- </desc>
- </func>
- <func>
- <name>stop() -> ok</name>
- <fsummary>Stops the test server immediately.</fsummary>
- <desc>
- <p>This stops the test server and
- all its activity. The running test suite (if any) will be
- halted.</p>
- </desc>
- </func>
- <func>
- <name>add_dir(Name, Dir) -> ok</name>
- <name>add_dir(Name, Dir, Pattern) -> ok</name>
- <name>add_dir(Name, [Dir|Dirs]) -> ok</name>
- <name>add_dir(Name, [Dir|Dirs], Pattern) -> ok</name>
- <fsummary>Add a directory to the job queue.</fsummary>
- <type>
- <v>Name = term()</v>
- <d>The jobname for this directory.</d>
- <v>Dir = term()</v>
- <d>The directory to scan for test suites.</d>
- <v>Dirs = [term()]</v>
- <d>List of directories to scan for test suites.</d>
- <v>Pattern = term()</v>
- <d>Suite match pattern. Directories will be scanned for Pattern_SUITE.erl files.</d>
- </type>
- <desc>
- <p>Puts a collection of suites matching (*_SUITE) in given
- directories into the job queue. <c>Name</c> is an arbitrary
- name for the job, it can be any erlang term. If <c>Pattern</c>
- is given, only modules matching <c>Pattern*</c> will be added.</p>
- </desc>
- </func>
- <func>
- <name>add_module(Mod) -> ok</name>
- <name>add_module(Name, [Mod|Mods]) -> ok</name>
- <fsummary>Add a module to the job queue with or without a given name.</fsummary>
- <type>
- <v>Mod = atom()</v>
- <v>Mods = [atom()]</v>
- <d>The name(s) of the module(s) to add.</d>
- <v>Name = term()</v>
- <d>Name for the job.</d>
- </type>
- <desc>
- <p>This function adds a module or a list of modules, to the
- test servers job queue. <c>Name</c> may be any Erlang
- term. When <c>Name</c> is not given, the job gets the name of
- the module.</p>
- </desc>
- </func>
- <func>
- <name>add_case(Mod, Case) -> ok</name>
- <fsummary>Adds one test case to the job queue.</fsummary>
- <type>
- <v>Mod = atom()</v>
- <d>Name of the module the test case is in.</d>
- <v>Case = atom() </v>
- <d>Function name of the test case to add.</d>
- </type>
- <desc>
- <p>This function will add one test case to the job queue. The
- job will be given the module's name.</p>
- </desc>
- </func>
- <func>
- <name>add_case(Name, Mod, Case) -> ok</name>
- <fsummary>Equivalent to add_case/2, but with specified name.</fsummary>
- <type>
- <v>Name = string()</v>
- <d>Name to use for the test job.</d>
- </type>
- <desc>
- <p>Equivalent to <c>add_case/2</c>, but the test job will get
- the specified name.</p>
- </desc>
- </func>
- <func>
- <name>add_cases(Mod, Cases) -> ok</name>
- <fsummary>Adds a list of test cases to the job queue.</fsummary>
- <type>
- <v>Mod = atom()</v>
- <d>Name of the module the test case is in.</d>
- <v>Cases = [Case] </v>
- <v>Case = atom() </v>
- <d>Function names of the test cases to add.</d>
- </type>
- <desc>
- <p>This function will add one or more test cases to the job
- queue. The job will be given the module's name.</p>
- </desc>
- </func>
- <func>
- <name>add_cases(Name, Mod, Cases) -> ok</name>
- <fsummary>Equivalent to add_cases/2, but with specified name.</fsummary>
- <type>
- <v>Name = string()</v>
- <d>Name to use for the test job.</d>
- </type>
- <desc>
- <p>Equivalent to <c>add_cases/2</c>, but the test job will get
- the specified name.</p>
- </desc>
- </func>
- <func>
- <name>add_spec(TestSpecFile) -> ok | {error, nofile}</name>
- <fsummary>Adds a test specification file to the job queue.</fsummary>
- <type>
- <v>TestSpecFile = string()</v>
- <d>Name of the test specification file</d>
- </type>
- <desc>
- <p>This function will add the content of the given test
- specification file to the job queue. The job will be given the
- name of the test specification file, e.g. if the file is
- called <c>test.spec</c>, the job will be called <c>test</c>.
- </p>
- <p>See the reference manual for the test server application
- for details about the test specification file.</p>
- </desc>
- </func>
- <func>
- <name>add_dir_with_skip(Name, [Dir|Dirs], Skip) -> ok</name>
- <name>add_dir_with_skip(Name, [Dir|Dirs], Pattern, Skip) -> ok</name>
- <name>add_module_with_skip(Mod, Skip) -> ok</name>
- <name>add_module_with_skip(Name, [Mod|Mods], Skip) -> ok</name>
- <name>add_case_with_skip(Mod, Case, Skip) -> ok</name>
- <name>add_case_with_skip(Name, Mod, Case, Skip) -> ok</name>
- <name>add_cases_with_skip(Mod, Cases, Skip) -> ok</name>
- <name>add_cases_with_skip(Name, Mod, Cases, Skip) -> ok</name>
- <fsummary>Same purpose as functions listed above, but with extra Skip argument.</fsummary>
- <type>
- <v>Skip = [SkipItem]</v>
- <d>List of items to be skipped from the test.</d>
- <v>SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment}</v>
- <v>Mod = atom()</v>
- <d>Test suite name.</d>
- <v>Comment = string()</v>
- <d>Reason why suite or case is being skipped.</d>
- <v>Cases = [Case]</v>
- <v>Case = atom()</v>
- <d>Name of test case function.</d>
- </type>
- <desc>
- <p>These functions add test jobs just like the add_dir, add_module,
- add_case and add_cases functions above, but carry an additional
- argument, Skip. Skip is a list of items that should be skipped
- in the current test run. Test job items that occur in the Skip
- list will be logged as SKIPPED with the associated Comment.</p>
- </desc>
- </func>
- <func>
- <name>add_tests_with_skip(Name, Tests, Skip) -> ok</name>
- <fsummary>Adds different types of jobs to the run queue.</fsummary>
- <type>
- <v>Name = term()</v>
- <d>The jobname for this directory.</d>
- <v>Tests = [TestItem]</v>
- <d>List of jobs to add to the run queue.</d>
- <v>TestItem = {Dir,all,all} | {Dir,Mods,all} | {Dir,Mod,Cases}</v>
- <v>Dir = term()</v>
- <d>The directory to scan for test suites.</d>
- <v>Mods = [Mod]</v>
- <v>Mod = atom()</v>
- <d>Test suite name.</d>
- <v>Cases = [Case]</v>
- <v>Case = atom()</v>
- <d>Name of test case function.</d>
- <v>Skip = [SkipItem]</v>
- <d>List of items to be skipped from the test.</d>
- <v>SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment}</v>
- <v>Comment = string()</v>
- <d>Reason why suite or case is being skipped.</d>
- </type>
- <desc>
- <p>This function adds various test jobs to the test_server_ctrl
- job queue. These jobs can be of different type (all or specific suites
- in one directory, all or specific cases in one suite, etc). It is also
- possible to get particular items skipped by passing them along in the
- Skip list (see the add_*_with_skip functions above).</p>
- </desc>
- </func>
- <func>
- <name>abort_current_testcase(Reason) -> ok | {error,no_testcase_running}</name>
- <fsummary>Aborts the test case currently executing.</fsummary>
- <type>
- <v>Reason = term()</v>
- <d>The reason for stopping the test case, which will be printed in the log.</d>
- </type>
- <desc>
- <p>When calling this function, the currently executing test case will be aborted.
- It is the user's responsibility to know for sure which test case is currently
- executing. The function is therefore only safe to call from a function which
- has been called (or synchronously invoked) by the test case.</p>
- </desc>
- </func>
- <func>
- <name>set_levels(Console, Major, Minor) -> ok</name>
- <fsummary>Sets the levels of I/O.</fsummary>
- <type>
- <v>Console = integer()</v>
- <d>Level for I/O to be sent to console.</d>
- <v>Major = integer()</v>
- <d>Level for I/O to be sent to the major logfile.</d>
- <v>Minor = integer()</v>
- <d>Level for I/O to be sent to the minor logfile.</d>
- </type>
- <desc>
- <p>Determines where I/O from test suites/test server will
- go. All text output from test suites and the test server is
- tagged with a priority value which ranges from 0 to 100, 100
- being the most detailed. (see the section about log files in
- the user's guide). Output from the test cases (using
- <c>io:format/2</c>) has a detail level of 50. Depending on the
- levels set by this function, this I/O may be sent to the
- console, the major log file (for the whole test suite) or to
- the minor logfile (separate for each test case).
- </p>
- <p>All output with detail level:</p>
- <list type="bulleted">
- <item>Less than or equal to <c>Console</c> is displayed on
- the screen (default 1)
- </item>
- <item>Less than or equal to <c>Major</c> is logged in the
- major log file (default 19)
- </item>
- <item>Greater than or equal to <c>Minor</c> is logged in the
- minor log files (default 10)
- </item>
- </list>
- <p>To view the currently set thresholds, use the
- <c>get_levels/0</c> function.</p>
- </desc>
- </func>
- <func>
- <name>get_levels() -> {Console, Major, Minor}</name>
- <fsummary>Returns the current levels.</fsummary>
- <desc>
- <p>Returns the current levels. See <c>set_levels/3</c> for
- types.</p>
- </desc>
- </func>
- <func>
- <name>jobs() -> JobQueue</name>
- <fsummary>Returns the job queue.</fsummary>
- <type>
- <v>JobQueue = [{list(), pid()}]</v>
- </type>
- <desc>
- <p>This function will return all the jobs currently in the job
- queue.</p>
- </desc>
- </func>
- <func>
- <name>multiply_timetraps(N) -> ok</name>
- <fsummary>All timetraps started after this will be multiplied by N.</fsummary>
- <type>
- <v>N = integer() | infinity</v>
- </type>
- <desc>
- <p>This function should be called before a test is started
- which requires extended timetraps, e.g. if extensive tracing
- is used. All timetraps started after this call will be
- multiplied by <c>N</c>.</p>
- </desc>
- </func>
- <func>
- <name>scale_timetraps(Bool) -> ok</name>
- <fsummary>.</fsummary>
- <type>
- <v>Bool = true | false</v>
- </type>
- <desc>
- <p>This function should be called before a test is started.
- The parameter specifies if test_server should attempt
- to automatically scale the timetrap value in order to compensate
- for delays caused by e.g. the cover tool.</p>
- </desc>
- </func>
- <func>
- <name>get_timetrap_parameters() -> {N,Bool} </name>
- <fsummary>Read the parameter values that affect timetraps.</fsummary>
- <type>
- <v>N = integer() | infinity</v>
- <v>Bool = true | false</v>
- </type>
- <desc>
- <p>This function may be called to read the values set by
- <c>multiply_timetraps/1</c> and <c>scale_timetraps/1</c>.</p>
- </desc>
- </func>
- <func>
- <name>cover(Application,Analyse) -> ok</name>
- <name>cover(CoverFile,Analyse) -> ok</name>
- <name>cover(App,CoverFile,Analyse) -> ok</name>
- <fsummary>Informs the test_server controller that next test shall run with code coverage analysis.</fsummary>
- <type>
- <v>Application = atom()</v>
- <d>OTP application to cover compile</d>
- <v>CoverFile = string()</v>
- <d>Name of file listing modules to exclude from or include in cover compilation. The filename must include full path to the file.</d>
- <v>Analyse = details | overview</v>
- </type>
- <desc>
- <p>This function informs the test_server controller that next
- test shall run with code coverage analysis. All timetraps will
- automatically be multiplied by 10 when cover i run.
- </p>
- <p><c>Application</c> and <c>CoverFile</c> indicates what to
- cover compile. If <c>Application</c> is given, the default is
- that all modules in the <c>ebin</c> directory of the
- application will be cover compiled. The <c>ebin</c> directory
- is found by adding <c>ebin</c> to
- <c>code:lib_dir(Application)</c>.
- </p>
- <p>A <c>CoverFile</c> can have the following entries:</p>
- <code type="none">
-{exclude, all | ExcludeModuleList}.
-{include, IncludeModuleList}.
-{cross, CrossCoverInfo}.</code>
- <p>Note that each line must end with a full
- stop. <c>ExcludeModuleList</c> and <c>IncludeModuleList</c>
- are lists of atoms, where each atom is a module name.
- </p>
-
- <p><c>CrossCoverInfo</c> is used when collecting cover data
- over multiple tests. Modules listed here are compiled, but
- they will not be analysed when the test is finished. See
- <seealso
- marker="#cross_cover_analyse-2">cross_cover_analyse/2</seealso>
- for more information about the cross cover mechanism and the
- format of <c>CrossCoverInfo</c>.
- </p>
- <p>If both an <c>Application</c> and a <c>CoverFile</c> is
- given, all modules in the application are cover compiled,
- except for the modules listed in <c>ExcludeModuleList</c>. The
- modules in <c>IncludeModuleList</c> are also cover compiled.
- </p>
- <p>If a <c>CoverFile</c> is given, but no <c>Application</c>,
- only the modules in <c>IncludeModuleList</c> are cover
- compiled.
- </p>
- <p><c>Analyse</c> indicates the detail level of the cover
- analysis. If <c>Analyse = details</c>, each cover compiled
- module will be analysed with
- <c>cover:analyse_to_file/1</c>. If <c>Analyse = overview</c>
- an overview of all cover compiled modules is created, listing
- the number of covered and not covered lines for each module.
- </p>
- <p>If the test following this call starts any slave or peer
- nodes with <c>test_server:start_node/3</c>, the same cover
- compiled code will be loaded on all nodes. If the loading
- fails, e.g. if the node runs an old version of OTP, the node
- will simply not be a part of the coverage analysis. Note that
- slave or peer nodes must be stopped with
- <c>test_server:stop_node/1</c> for the node to be part of the
- coverage analysis, else the test server will not be able to
- fetch coverage data from the node.
- </p>
- <p>When the test is finished, the coverage analysis is
- automatically completed, logs are created and the cover
- compiled modules are unloaded. If another test is to be run
- with coverage analysis, <c>test_server_ctrl:cover/2/3</c> must
- be called again.
- </p>
- </desc>
- </func>
- <func>
- <name>cross_cover_analyse(Level, Tests) -> ok</name>
- <fsummary>Analyse cover data collected from multiple tests</fsummary>
- <type>
- <v>Level = details | overview</v>
- <v>Tests = [{Tag,LogDir}]</v>
- <v>Tag = atom()</v>
- <d>Test identifier.</d>
- <v>LogDir = string()</v>
- <d>Log directory for the test identified by <c>Tag</c>. This
- can either be the <c>run.&lt;timestamp&gt;</c> directory or
- the parent directory of this (in which case the latest
- <c>run.&lt;timestamp&gt;</c> directory is chosen.</d>
- </type>
- <desc>
- <p>Analyse cover data collected from multiple tests. The modules
- analysed are the ones listed in <c>cross</c> statements in
- the cover files. These are modules that are heavily used by
- other tests than the one where they belong or are explicitly
- tested. They should then be listed as cross modules in the
- cover file for the test where they are used but do not
- belong. Se example below.</p>
- <p>This function should be run after all tests are completed,
- and the result will be stored in a file called
- <c>cross_cover.html</c> in the <c>run.&lt;timestamp&gt;</c>
- directory of the test the modules belong to.</p>
- <p>Note that the function can be executed on any node, and it
- does not require <c>test_server_ctrl</c> to be started first.</p>
- <p>The <c>cross</c> statement in the cover file must be like this:</p>
- <code type="none">
-{cross,[{Tag,Modules}]}.</code>
- <p>where <c>Tag</c> is the same as <c>Tag</c> in the
- <c>Tests</c> parameter to this function and <c>Modules</c> is a
- list of module names (atoms).</p>
- <p><em>Example:</em></p>
- <p>If the module <c>m1</c> belongs to system <c>s1</c> but is
- heavily used also in the tests for another system <c>s2</c>,
- then the cover files for the two systems' tests could be like
- this:</p>
-<code type="none">
-s1.cover:
- {include,[m1]}.
-
-s2.cover:
- {include,[....]}. % modules belonging to system s2
- {cross,[{s1,[m1]}]}.</code>
- <p>When the tests for both <c>s1</c> and <c>s2</c> are completed, run</p>
-<code type="none">
-test_server_ctrl:cross_cover_analyse(Level,[{s1,S1LogDir},{s2,S2LogDir}])
-</code>
-
- <p>and the accumulated cover data for <c>m1</c> will be written to
- <c>S1LogDir/[run.&lt;timestamp&gt;/]cross_cover.html</c>.</p>
- <p>Note that the <c>m1</c> module will also be presented in the
- normal coverage log for <c>s1</c> (due to the include statement in
- <c>s1.cover</c>), but that only includes the coverage achieved by the
- <c>s1</c> test itself.</p>
- <p>The Tag in the <c>cross</c> statement in the cover file has
- no other purpose than mapping the list of modules
- (<c>[m1]</c> in the example above) to the correct log
- directory where it should be included in the
- <c>cross_cover.html</c> file (<c>S1LogDir</c> in the example
- above). I.e. the value of <c>Tag</c> has no meaning, it
- could be <c>foo</c> as well as <c>s1</c> above, as long as
- the same <c>Tag</c> is used in the cover file and in the
- call to this function.</p>
- </desc>
- </func>
- <func>
- <name>trc(TraceInfoFile) -> ok | {error, Reason}</name>
- <fsummary>Starts call trace on target and slave nodes</fsummary>
- <type>
- <v>TraceInfoFile = atom() | string()</v>
- <d>Name of a file defining which functions to trace and how</d>
- </type>
- <desc>
- <p>This function starts call trace on target and on slave or
- peer nodes that are started or will be started by the test
- suites.
- </p>
- <p>Timetraps are not extended automatically when tracing is
- used. Use <c>multiply_timetraps/1</c> if necessary.
- </p>
- <p>Note that the trace support in the test server is in a very
- early stage of the implementation, and thus not yet as
- powerful as one might wish for.
- </p>
- <p>The trace information file specified by the
- <c>TraceInfoFile</c> argument is a text file containing one or
- more of the following elements:
- </p>
- <list type="bulleted">
- <item><c>{SetTP,Module,Pattern}.</c></item>
- <item><c>{SetTP,Module,Function,Pattern}.</c></item>
- <item><c>{SetTP,Module,Function,Arity,Pattern}.</c></item>
- <item><c>ClearTP.</c></item>
- <item><c>{ClearTP,Module}.</c></item>
- <item><c>{ClearTP,Module,Function}.</c></item>
- <item><c>{ClearTP,Module,Function,Arity}.</c></item>
- </list>
- <taglist>
- <tag><c>SetTP = tp | tpl</c></tag>
- <item>This is maps to the corresponding functions in the
- <c>ttb</c> module in the <c>observer</c>
- application. <c>tp</c> means set trace pattern on global
- function calls. <c>tpl</c> means set trace pattern on local
- and global function calls.
- </item>
- <tag><c>ClearTP = ctp | ctpl | ctpg</c></tag>
- <item>This is maps to the corresponding functions in the
- <c>ttb</c> module in the <c>observer</c>
- application. <c>ctp</c> means clear trace pattern (i.e. turn
- off) on global and local function calls. <c>ctpl</c> means
- clear trace pattern on local function calls only and <c>ctpg</c>
- means clear trace pattern on global function calls only.
- </item>
- <tag><c>Module = atom()</c></tag>
- <item>The module to trace
- </item>
- <tag><c>Function = atom()</c></tag>
- <item>The name of the function to trace
- </item>
- <tag><c>Arity = integer()</c></tag>
- <item>The arity of the function to trace
- </item>
- <tag><c>Pattern = [] | match_spec()</c></tag>
- <item>The trace pattern to set for the module or
- function. For a description of the match_spec() syntax,
- please turn to the User's guide for the runtime system
- (erts). The chapter "Match Specification in Erlang" explains
- the general match specification language.
- </item>
- </taglist>
- <p>The trace result will be logged in a (binary) file called
- <c>NodeName-test_server</c> in the current directory of the
- test server controller node. The log must be formatted using
- <c>ttb:format/1/2</c>.
- </p>
- </desc>
- </func>
- <func>
- <name>stop_trace() -> ok | {error, not_tracing}</name>
- <fsummary>Stops tracing on target and slave nodes.</fsummary>
- <desc>
- <p>This function stops tracing on target, and on slave or peer
- nodes that are currently running. New slave or peer nodes will
- no longer be traced after this.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>FUNCTIONS INVOKED FROM COMMAND LINE</title>
- <p>The following functions are supposed to be invoked from the
- command line using the <c>-s</c> option when starting the erlang
- node.</p>
- </section>
- <funcs>
- <func>
- <name>run_test(CommandLine) -> ok</name>
- <fsummary>Runs the tests specified on the command line.</fsummary>
- <type>
- <v>CommandLine = FlagList</v>
- </type>
- <desc>
- <p>This function is supposed to be invoked from the
- commandline. It starts the test server, interprets the
- argument supplied from the commandline, runs the tests
- specified and when all tests are done, stops the test server
- and returns to the Erlang prompt.
- </p>
- <p>The <c>CommandLine</c> argument is a list of command line
- flags, typically <c>['KEY1', Value1, 'KEY2', Value2, ...]</c>.
- The valid command line flags are listed below.
- </p>
- <p>Under a UNIX command prompt, this function can be invoked like this:
- <br></br>
-<c>erl -noshell -s test_server_ctrl run_test KEY1 Value1 KEY2 Value2 ... -s erlang halt</c></p>
- <p>Or make an alias (this is for unix/tcsh) <br></br>
-<c>alias erl_test 'erl -noshell -s test_server_ctrl run_test \!* -s erlang halt'</c></p>
- <p>And then use it like this <br></br>
-<c>erl_test KEY1 Value1 KEY2 Value2 ...</c> <br></br>
-</p>
- <p>The valid command line flags are</p>
- <taglist>
- <tag><c>DIR dir</c></tag>
- <item>Adds all test modules in the directory <c>dir</c> to
- the job queue.
- </item>
- <tag><c>MODULE mod</c></tag>
- <item>Adds the module <c>mod</c> to the job queue.
- </item>
- <tag><c>CASE mod case</c></tag>
- <item>Adds the case <c>case</c> in module <c>mod</c> to the
- job queue.
- </item>
- <tag><c>SPEC spec</c></tag>
- <item>Runs the test specification file <c>spec</c>.
- </item>
- <tag><c>SKIPMOD mod</c></tag>
- <item>Skips all test cases in the module <c>mod</c></item>
- <tag><c>SKIPCASE mod case</c></tag>
- <item>Skips the test case <c>case</c> in module <c>mod</c>.
- </item>
- <tag><c>NAME name</c></tag>
- <item>Names the test suite to something else than the
- default name. This does not apply to <c>SPEC</c> which keeps
- its names.
- </item>
- <tag><c>COVER app cover_file analyse</c></tag>
- <item>Indicates that the test should be run with cover
- analysis. <c>app</c>, <c>cover_file</c> and <c>analyse</c>
- corresponds to the parameters to
- <c>test_server_ctrl:cover/3</c>. If no cover file is used,
- the atom <c>none</c> should be given.
- </item>
- <tag><c>TRACE traceinfofile</c></tag>
- <item>Specifies a trace information file. When this option
- is given, call tracing is started on the target node and all
- slave or peer nodes that are started. The trace information
- file specifies which modules and functions to trace. See the
- function <c>trc/1</c> above for more information about the
- syntax of this file.
- </item>
- </taglist>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>FRAMEWORK CALLBACK FUNCTIONS</title>
- <p>A test server framework can be defined by setting the
- environment variable <c>TEST_SERVER_FRAMEWORK</c> to a module
- name. This module will then be framework callback module, and it
- must export the following function:</p>
- </section>
- <funcs>
- <func>
- <name>get_suite(Mod,Func) -> TestCaseList</name>
- <fsummary>Get subcases.</fsummary>
- <type>
- <v>Mod = atom()</v>
- <d>Test suite name.</d>
- <v>Func = atom()</v>
- <d>Name of test case.</d>
- <v>TestCaseList = [SubCase]</v>
- <d>List of test cases.</d>
- <v>SubCase = atom()</v>
- <d>Name of a case.</d>
- </type>
- <desc>
- <p>This function is called before a test case is started. The
- purpose is to retrieve a list of subcases. The default
- behaviour of this function should be to call
- <c>Mod:Func(suite)</c> and return the result from this call.</p>
- </desc>
- </func>
- <func>
- <name>init_tc(Mod,Func,Args0) -> {ok,Args1} | {skip,ReasonToSkip} | {auto_skip,ReasonToSkip} | {fail,ReasonToFail}</name>
- <fsummary>Preparation for a test case or configuration function.</fsummary>
- <type>
- <v>Mod = atom()</v>
- <d>Test suite name.</d>
- <v>Func = atom()</v>
- <d>Name of test case or configuration function.</d>
- <v>Args0 = Args1 = [tuple()]</v>
- <d>Normally Args = [Config]</d>
- <v>ReasonToSkip = term()</v>
- <d>Reason to skip the test case or configuration function.</d>
- <v>ReasonToFail = term()</v>
- <d>Reason to fail the test case or configuration function.</d>
- </type>
- <desc>
- <p>This function is called before a test case or configuration
- function starts. It is called on the process executing the function
- <c>Mod:Func</c>. Typical use of this function can be to alter
- the input parameters to the test case function (<c>Args</c>) or
- to set properties for the executing process.</p>
- <p>By returning <c>{skip,Reason}</c>, <c>Func</c> gets skipped.
- <c>Func</c> also gets skipped if <c>{auto_skip,Reason}</c> is returned,
- but then gets an auto skipped status (rather than user skipped).</p>
- <p>To fail <c>Func</c> immediately instead of executing it, return
- <c>{fail,ReasonToFail}.</c></p>
- </desc>
- </func>
- <func>
- <name>end_tc(Mod,Func,Status) -> ok | {fail,ReasonToFail}</name>
- <fsummary>Cleanup after a test case or configuration function.</fsummary>
- <type>
- <v>Mod = atom()</v>
- <d>Test suite name.</d>
- <v>Func = atom()</v>
- <d>Name of test case or configuration function.</d>
- <v>Status = {Result,Args} | {TCPid,Result,Args}</v>
- <d>The status of the test case or configuration function.</d>
- <v>ReasonToFail = term()</v>
- <d>Reason to fail the test case or configuration function.</d>
- <v>Result = ok | Skip | Fail</v>
- <d>The final result of the test case or configuration function.</d>
- <v>TCPid = pid()</v>
- <d>Pid of the process executing Func</d>
- <v>Skip = {skip,SkipReason}</v>
- <v>SkipReason = term() | {failed,{Mod,init_per_testcase,term()}}</v>
- <d>Reason why the function was skipped.</d>
- <v>Fail = {error,term()} | {'EXIT',term()} | {timetrap_timeout,integer()} |
- {testcase_aborted,term()} | testcase_aborted_or_killed |
- {failed,term()} | {failed,{Mod,end_per_testcase,term()}}</v>
- <d>Reason why the function failed.</d>
- <v>Args = [tuple()]</v>
- <d>Normally Args = [Config]</d>
- </type>
- <desc>
- <p>This function is called when a test case, or a configuration function,
- is finished. It is normally called on the process where the function
- <c>Mod:Func</c> has been executing, but if not, the pid of the test
- case process is passed with the <c>Status</c> argument.</p>
- <p>Typical use of the <c>end_tc/3</c> function can be to clean up
- after <c>init_tc/3</c>.</p>
- <p>If <c>Func</c> is a test case, it is possible to analyse the value of
- <c>Result</c> to verify that <c>init_per_testcase/2</c> and
- <c>end_per_testcase/2</c> executed successfully.</p>
- <p>It is possible with <c>end_tc/3</c> to fail an otherwise successful
- test case, by returning <c>{fail,ReasonToFail}</c>. The test case <c>Func</c>
- will be logged as failed with the provided term as reason.</p>
- </desc>
- </func>
- <func>
- <name>report(What,Data) -> ok</name>
- <fsummary>Progress report for test.</fsummary>
- <type>
- <v>What = atom()</v>
- <v>Data = term()</v>
- </type>
- <desc>
- <p>This function is called in order to keep the framework up-to-date with
- the progress of the test. This is useful e.g. if the
- framework implements a GUI where the progress information is
- constantly updated. The following can be reported:
- </p>
- <p><c>What = tests_start, Data = {Name,NumCases}</c><br></br>
- <c>What = loginfo, Data = [{topdir,TestRootDir},{rundir,CurrLogDir}]</c><br></br>
- <c>What = tests_done, Data = {Ok,Failed,{UserSkipped,AutoSkipped}}</c><br></br>
- <c>What = tc_start, Data = {{Mod,{Func,GroupName}},TCLogFile}</c><br></br>
- <c>What = tc_done, Data = {Mod,{Func,GroupName},Result}</c><br></br>
- <c>What = tc_user_skip, Data = {Mod,{Func,GroupName},Comment}</c><br></br>
- <c>What = tc_auto_skip, Data = {Mod,{Func,GroupName},Comment}</c><br></br>
- <c>What = framework_error, Data = {{FWMod,FWFunc},Error}</c></p>
- <p>Note that for a test case function that doesn't belong to a group,
- <c>GroupName</c> has value <c>undefined</c>, otherwise the name of the test
- case group.</p>
- </desc>
- </func>
- <func>
- <name>error_notification(Mod, Func, Args, Error) -> ok</name>
- <fsummary>Inform framework of crashing testcase or configuration function.</fsummary>
- <type>
- <v>Mod = atom()</v>
- <d>Test suite name.</d>
- <v>Func = atom()</v>
- <d>Name of test case or configuration function.</d>
- <v>Args = [tuple()]</v>
- <d>Normally Args = [Config]</d>
- <v>Error = {Reason,Location}</v>
- <v>Reason = term()</v>
- <d>Reason for termination.</d>
- <v>Location = unknown | [{Mod,Func,Line}]</v>
- <d>Last known position in Mod before termination.</d>
- <v>Line = integer()</v>
- <d>Line number in file Mod.erl.</d>
- </type>
- <desc>
- <p>This function is called as the result of function <c>Mod:Func</c> failing
- with Reason at Location. The function is intended mainly to aid
- specific logging or error handling in the framework application. Note
- that for Location to have relevant values (i.e. other than unknown),
- the <c>line</c> macro or <c>test_server_line</c> parse transform must
- be used. For details, please see the section about test suite line numbers
- in the <c>test_server</c> reference manual page.</p>
- </desc>
- </func>
- <func>
- <name>warn(What) -> boolean()</name>
- <fsummary>Ask framework if test server should issue a warning for What.</fsummary>
- <type>
- <v>What = processes | nodes</v>
- </type>
- <desc>
- <p>The test server checks the number of processes and nodes
- before and after the test is executed. This function is a
- question to the framework if the test server should warn when
- the number of processes or nodes has changed during the test
- execution. If <c>true</c> is returned, a warning will be written
- in the test case minor log file.</p>
- </desc>
- </func>
- <func>
- <name>target_info() -> InfoStr</name>
- <fsummary>Print info about the target system to the test case log.</fsummary>
- <type>
- <v>InfoStr = string() | ""</v>
- </type>
- <desc>
- <p>The test server will ask the framework for information about
- the test target system and print InfoStr in the test case
- log file below the host information.</p>
- </desc>
- </func>
- </funcs>
-</erlref>
-
diff --git a/lib/test_server/doc/src/test_spec_chapter.xml b/lib/test_server/doc/src/test_spec_chapter.xml
deleted file mode 100644
index 0a62010364..0000000000
--- a/lib/test_server/doc/src/test_spec_chapter.xml
+++ /dev/null
@@ -1,375 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Test Structure and Test Specifications</title>
- <prepared>Siri Hansen</prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>test_spec_chapter.xml</file>
- </header>
-
- <section>
- <title>Test structure</title>
- <p>A test consists of a set of test cases. Each test case is
- implemented as an erlang function. An erlang module implementing
- one or more test cases is called a test suite.
- </p>
- </section>
-
- <section>
- <title>Test specifications</title>
- <p>A test specification is a specification of which test suites
- and test cases to run and which to skip. A test specification can
- also group several test cases into conf cases with init and
- cleanup functions (see section about configuration cases
- below). In a test there can be test specifications on three
- different levels:
- </p>
- <p>The top level is a test specification file which roughly
- specifies what to test for a whole application. The test
- specification in such a file is encapsulated in a topcase
- command.
- </p>
- <p>Then there is a test specification for each test suite,
- specifying which test cases to run within the suite. The test
- specification for a test suite is returned from the
- <c>all(suite)</c> function in the test suite module.
- </p>
- <p>And finally there can be a test specification per test case,
- specifying sub test cases to run. The test specification for a
- test case is returned from the specification clause of the test
- case.
- </p>
- <p>When a test starts, the total test specification is built in a
- tree fashion, starting from the top level test specification.
- </p>
- <p>The following are the valid elements of a test
- specification. The specification can be one of these elements or a
- list with any combination of the elements:
- </p>
- <taglist>
- <tag><c>{Mod, Case}</c></tag>
- <item>This specifies the test case Mod:Case/1
- </item>
- <tag><c>{dir, Dir}</c></tag>
- <item>This specifies all modules <c>*_SUITE</c> in the directory
- <c>Dir</c></item>
- <tag><c>{dir, Dir, Pattern}</c></tag>
- <item>This specifies all modules <c>Pattern*</c> in the
- directory <c>Dir</c></item>
- <tag><c>{conf, Init, TestSpec, Fin}</c></tag>
- <item>This is a configuration case. In a test specification
- file, <c>Init</c> and <c>Fin</c> must be
- <c>{Mod,Func}</c>. Inside a module they can also be just
- <c>Func</c>. See the section named Configuration Cases below for
- more information about this.
- </item>
- <tag><c>{conf, Properties, Init, TestSpec, Fin}</c></tag>
- <item>This is a configuration case as explained above, but
- which also takes a list of execution properties for its group
- of test cases and nested sub-groups.
- </item>
- <tag><c>{make, Init, TestSpec, Fin}</c></tag>
- <item>This is a special version of a conf case which is only
- used by the test server framework <c>ts</c>. <c>Init</c> and
- <c>Fin</c> are make and unmake functions for a data
- directory. <c>TestSpec</c> is the test specification for the
- test suite owning the data directory in question. If the make
- function fails, all tests in the test suite are skipped. The
- difference between this "make case" and a normal conf case is
- that for the make case, <c>Init</c> and <c>Fin</c> are given with
- arguments (<c>{Mod,Func,Args}</c>).
- </item>
- <tag><c>Case</c></tag>
- <item>This can only be used inside a module, i.e. not a test
- specification file. It specifies the test case
- <c>CurrentModule:Case</c>.
- </item>
- </taglist>
- </section>
-
- <section>
- <title>Test Specification Files</title>
- <p>A test specification file is a text file containing the top
- level test specification (a topcase command), and possibly one or
- more additional commands. A "command" in a test specification file
- means a key-value tuple ended by a dot-newline sequence.
- </p>
- <p>The following commands are valid:
- </p>
- <taglist>
- <tag><c>{topcase, TestSpec}</c></tag>
- <item>This command is mandatory in all test specification
- files. <c>TestSpec</c> is the top level test specification of a
- test.
- </item>
- <tag><c>{skip, {Mod, Comment}}</c></tag>
- <item>This specifies that all cases in the module <c>Mod</c>
- shall be skipped. <c>Comment</c> is a string.
- </item>
- <tag><c>{skip, {Mod, Case, Comment}}</c></tag>
- <item>This specifies that the case <c>Mod:Case</c> shall be
- skipped.
- </item>
- <tag><c>{skip, {Mod, CaseList, Comment}}</c></tag>
- <item>This specifies that all cases <c>Mod:Case</c>, where
- <c>Case</c> is in <c>CaseList</c>, shall be skipped.
- </item>
- <tag><c>{nodes, Nodes}</c></tag>
- <item><c>Nodes</c> is a list of nodenames available to the test
- suite. It will be added to the <c>Config</c> argument to all
- test cases. <c>Nodes</c> is a list of atoms.
- </item>
- <tag><c>{require_nodenames, Num}</c></tag>
- <item>Specifies how many nodenames the test suite will
- need. Theese will be automatically generated and inserted into the
- <c>Config</c> argument to all test cases. <c>Num</c> is an
- integer.
- </item>
- <tag><c>{hosts, Hosts}</c></tag>
- <item>This is a list of available hosts on which to start slave
- nodes. It is used when the <c>{remote, true}</c> option is given
- to the <c>test_server:start_node/3</c> function. Also, if
- <c>{require_nodenames, Num}</c> is contained in a test
- specification file, the generated nodenames will be spread over
- all hosts given in this <c>Hosts</c> list. The hostnames are
- atoms or strings.
- </item>
- <tag><c>{diskless, true}</c></tag>
- <item>Adds <c>{diskless, true}</c> to the <c>Config</c> argument
- to all test cases. This is kept for backwards compatibility and
- should not be used. Use a configuration case instead.
- </item>
- <tag><c>{ipv6_hosts, Hosts}</c></tag>
- <item>Adds <c>{ipv6_hosts, Hosts}</c> to the <c>Config</c>
- argument to all test cases.</item>
- </taglist>
- <p>All test specification files shall have the extension
- ".spec". If special test specification files are needed for
- Windows or VxWorks platforms, additional files with the
- extension ".spec.win" and ".spec.vxworks" shall be
- used. This is useful e.g. if some test cases shall be skipped on
- these platforms.
- </p>
- <p>Some examples for test specification files can be found in the
- Examples section of this user's guide.
- </p>
- </section>
-
- <section>
- <title>Configuration cases</title>
- <p>If a group of test cases need the same initialization, a so called
- <em>configuration</em> or <em>conf</em> case can be used. A conf
- case consists of an initialization function, the group of test cases
- needing this initialization and a cleanup or finalization function.
- </p>
- <p>If the init function in a conf case fails or returns
- <c>{skip,Comment}</c>, the rest of the test cases in the conf case
- (including the cleanup function) are skipped. If the init function
- succeeds, the cleanup function will always be called, even if some
- of the test cases in between failed.
- </p>
- <p>Both the init function and the cleanup function in a conf case
- get the <c>Config</c> parameter as only argument. This parameter
- can be modified or returned as is. Whatever is returned by the
- init function is given as <c>Config</c> parameter to the rest of
- the test cases in the conf case, including the cleanup function.
- </p>
- <p>If the <c>Config</c> parameter is changed by the init function,
- it must be restored by the cleanup function. Whatever is returned
- by the cleanup function will be given to the next test case called.
- </p>
- <p>The optional <c>Properties</c> list can be used to specify
- execution properties for the test cases and possibly nested
- sub-groups of the configuration case. The available properties are:</p>
- <pre>
- Properties = [parallel | sequence | Shuffle | {RepeatType,N}]
- Shuffle = shuffle | {shuffle,Seed}
- Seed = {integer(),integer(),integer()}
- RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |
- repeat_until_any_ok | repeat_until_any_fail
- N = integer() | forever</pre>
-
- <p>If the <c>parallel</c> property is specified, Test Server will execute
- all test cases in the group in parallel. If <c>sequence</c> is specified,
- the cases will be executed in a sequence, meaning if one case fails, all
- following cases will be skipped. If <c>shuffle</c> is specified, the cases
- in the group will be executed in random order. The <c>repeat</c> property
- orders Test Server to repeat execution of the cases in the group a given
- number of times, or until any, or all, cases fail or succeed.</p>
-
- <p>Properties may be combined so that e.g. if <c>shuffle</c>,
- <c>repeat_until_any_fail</c> and <c>sequence</c> are all specified, the test
- cases in the group will be executed repeatedly and in random order until
- a test case fails, when execution is immediately stopped and the rest of
- the cases skipped.</p>
-
- <p>The properties for a conf case is always printed on the top of the HTML log
- for the group's init function. Also, the total execution time for a conf case
- can be found at the bottom of the log for the group's end function.</p>
-
- <p>Configuration cases may be nested so that sets of grouped cases can be
- configured with the same init- and end functions.</p>
- </section>
-
- <section>
- <title>The parallel property and nested configuration cases</title>
- <p>If a conf case has a parallel property, its test cases will be spawned
- simultaneously and get executed in parallel. A test case is not allowed
- to execute in parallel with the end function however, which means
- that the time it takes to execute a set of parallel cases is equal to the
- execution time of the slowest test case in the group. A negative side
- effect of running test cases in parallel is that the HTML summary pages
- are not updated with links to the individual test case logs until the
- end function for the conf case has finished.</p>
-
- <p>A conf case nested under a parallel conf case will start executing in
- parallel with previous (parallel) test cases (no matter what properties the
- nested conf case has). Since, however, test cases are never executed in
- parallel with the init- or the end function of the same conf case, it's
- only after a nested group of cases has finished that any remaining parallel
- cases in the previous conf case get spawned.</p>
- </section>
-
- <section>
- <title>Repeated execution of test cases</title>
- <marker id="repeated_cases"></marker>
- <p>A conf case may be repeated a certain number of times
- (specified by an integer) or indefinitely (specified by <c>forever</c>).
- The repetition may also be stopped prematurely if any or all cases
- fail or succeed, i.e. if the property <c>repeat_until_any_fail</c>,
- <c>repeat_until_any_ok</c>, <c>repeat_until_all_fail</c>, or
- <c>repeat_until_all_ok</c> is used. If the basic <c>repeat</c>
- property is used, status of test cases is irrelevant for the repeat
- operation.</p>
-
- <p>It is possible to return the status of a conf case (ok or
- failed), to affect the execution of the conf case on the level above.
- This is accomplished by, in the end function, looking up the value
- of <c>tc_group_properties</c> in the <c>Config</c> list and checking the
- result of the finished test cases. If status <c>failed</c> should be
- returned from the conf case as a result, the end function should return
- the value <c>{return_group_result,failed}</c>. The status of a nested conf
- case is taken into account by Test Server when deciding if execution
- should be repeated or not (unless the basic <c>repeat</c> property is used).</p>
-
- <p>The <c>tc_group_properties</c> value is a list of status tuples,
- each with the key <c>ok</c>, <c>skipped</c> and <c>failed</c>. The
- value of a status tuple is a list containing names of test cases
- that have been executed with the corresponding status as result.</p>
-
- <p>Here's an example of how to return the status from a conf case:</p>
- <pre>
- conf_end_function(Config) ->
- Status = ?config(tc_group_result, Config),
- case proplists:get_value(failed, Status) of
- [] -> % no failed cases
- {return_group_result,ok};
- _Failed -> % one or more failed
- {return_group_result,failed}
- end.</pre>
-
- <p>It is also possible in the end function to check the status of
- a nested conf case (maybe to determine what status the current conf case should
- return). This is as simple as illustrated in the example above, only the
- name of the end function of the nested conf case is stored in a tuple
- <c>{group_result,EndFunc}</c>, which can be searched for in the status lists.
- Example:</p>
- <pre>
- conf_end_function_X(Config) ->
- Status = ?config(tc_group_result, Config),
- Failed = proplists:get_value(failed, Status),
- case lists:member({group_result,conf_end_function_Y}, Failed) of
- true ->
- {return_group_result,failed};
- false ->
- {return_group_result,ok}
- end;
- ...</pre>
-
- <note><p>When a conf case is repeated, the init- and end functions
- are also always called with each repetition.</p></note>
- </section>
-
- <section>
- <title>Shuffled test case order</title>
- <p>The order that test cases in a conf case are executed, is under normal
- circumstances the same as the order defined in the test specification.
- With the <c>shuffle</c> property set, however, Test Server will instead
- execute the test cases in random order.</p>
-
- <p>The user may provide a seed value (a tuple of three integers) with
- the shuffle property: <c>{shuffle,Seed}</c>. This way, the same shuffling
- order can be created every time the conf case is executed. If no seed value
- is given, Test Server creates a "random" seed for the shuffling operation
- (using the return value of <c>erlang:now()</c>). The seed value is always
- printed to the log file of the init function so that it can be used to
- recreate the same execution order in subsequent test runs.</p>
-
- <note><p>If execution of a conf case with shuffled test cases is repeated,
- the seed will not be reset in between turns.</p></note>
-
- <p>If a nested conf case is specified in a conf case with a <c>shuffle</c>
- property, the execution order of the nested cases in relation to the test cases
- (and other conf cases) is also random. The order of the test cases in the nested
- conf case is however not random (unless, of course, this one also has a
- <c>shuffle</c> property).</p>
- </section>
-
- <section>
- <title>Skipping test cases</title>
- <p>It is possible to skip certain test cases, for example if you
- know beforehand that a specific test case fails. This might be
- functionality which isn't yet implemented, a bug that is known but
- not yet fixed or some functionality which doesn't work or isn't
- applicable on a specific platform.
- </p>
- <p>There are several different ways to state that a test case
- should be skipped:</p>
- <list type="bulleted">
- <item>Using the <c>{skip,What}</c> command in a test
- specification file
- </item>
- <item>Returning <c>{skip,Reason}</c> from the
- <c>init_per_testcase/2</c> function
- </item>
- <item>Returning <c>{skip,Reason}</c> from the specification
- clause of the test case
- </item>
- <item>Returning <c>{skip,Reason}</c> from the execution clause
- of the test case
- </item>
- </list>
- <p>The latter of course means that the execution clause is
- actually called, so the author must make sure that the test case
- is not run. For more information about the different clauses in a
- test case, see the chapter about writing test cases.
- </p>
- <p>When a test case is skipped, it will be noted as <c>SKIPPED</c>
- in the HTML log.
- </p>
- </section>
-</chapter>
-
diff --git a/lib/test_server/doc/src/ts.xml b/lib/test_server/doc/src/ts.xml
deleted file mode 100644
index 60dfdbc545..0000000000
--- a/lib/test_server/doc/src/ts.xml
+++ /dev/null
@@ -1,568 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2007</year>
- <year>2013</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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.
- </legalnotice>
-
- <title>The OTP Test Server Framework</title>
- <prepared>Mattias Nilsson</prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date></date>
- <rev></rev>
- <file>ts.xml</file>
- </header>
- <module>ts</module>
- <modulesummary>Test Server Framework for testing OTP</modulesummary>
- <description>
- <p>This is a framework for testing OTP. The <c>ts</c> module
- implements the interface to all the functionality in the
- framework.
- </p>
- <p>The framework is built on top of the Test Server Controller,
- <c>test_server_ctrl</c>, and provides a high level operator
- interface. The main features added by the framework are:
- </p>
- <list type="bulleted">
- <item>Automatic compilation of test suites and data directories
- </item>
- <item>Collection of files in central directories and creation of
- additional HTML pages for better overview.
- </item>
- <item>Single command interface for running all available tests
- </item>
- <item>Spawns a new node with correct parameters before starting
- the test server
- </item>
- <item>Atomatically creates the parameter file needed when
- running tests on remote target
- </item>
- </list>
- <p>More information about the Test Server Framework and how to run
- test cases can be found in the Test Server User's Guide.
- </p>
- <p>For writing you own test server framework, please turn to the
- reference manual for the Test Server Controller and chapter named
- "Writing your own test server framework" in the Test Server User's
- Guide.
- </p>
- <p>SETUP</p>
- <p>To be able to run <c>ts</c>, you must first `install'
- <c>ts</c> for the current environment. This is done by calling
- <c>ts:install/0/1/2</c>. A file called `variables' is created
- and used by <c>ts</c> when running test suites. It is not
- recommended to edit this file, but it is possible to alter if
- <c>ts</c> gets the wrong idea about your environment.
- </p>
- <p><c>ts:install/0</c> is used if the target platform is the
- same as the controller host, i.e. if you run on "local target"
- and no options are needed. Then running <c>ts:install/0</c> <c>ts</c>
- will run an autoconf script for your current
- environment and set up the necessary variables needed by the
- test suites.
- </p>
- <p><c>ts:install/1</c> or <c>ts:install/2</c> is used if the
- target platform is different from the controller host, i.e. if
- you run on "remote target" or if special options are required
- for your system.
- </p>
- <p>See the reference manual for detailed information about
- <c>ts:install/0/1/2</c>.
- </p>
- <p>Some of the common variables in the 'variables' file are
- described below. Do not make any assumptions as of what is found
- in this file, as it may change at any time.
- </p>
- <list>
- <item><c>longnames</c><br></br>
- Set to true if the system is using fully qualified
- nodenames.
- </item>
- <item><c>platform_id</c><br></br>
- This is the currently installed platform identification
- string.
- </item>
- <item><c>platform_filename</c><br></br>
- This is the name used to create the final save directory
- for test runs.
- </item>
- <item><c>platform_label</c><br></br>
- This is the string presented in the generated test
- results index page.
- </item>
- <item><c>rsh_name</c><br></br>
- This is the rsh program to use when starting slave or
- peer nodes on a remote host.
- </item>
- <item><c>erl_flags</c><br></br>
- Compile time flags used when compiling test suites.
- </item>
- <item><c>erl_release</c><br></br>
- The Erlang/OTP release being tested.
- </item>
- <item><c>'EMULATOR'</c><br></br>
- The emulator being tested (e.g. beam)
- </item>
- <item><c>'CPU'</c><br></br>
- The CPU in the machine running the tests, e.g. sparc.
- </item>
- <item><c>target_host</c><br></br>
- The target host name
- </item>
- <item><c>os</c><br></br>
- The target operating system, e.g. solaris2.8
- </item>
- <item><c>target</c><br></br>
- The current target platform, e.g. sparc-sun-solaris2.8
- </item>
- </list>
- <p>RUNNING TESTS</p>
- <p>After installing <c>ts</c>, you can run your test with the
- <c>ts:run/0/1/2/3/4</c> functions. These functions, however,
- require a special directory structure to be able to find your
- test suites. Both the test server and all tests must be located
- under your $TESTROOT directory. The test server implementation
- shall be located in the directory <c>$TESTROOT/test_server</c>
- and for each application there must be a directory named
- <c><![CDATA[$TESTROOT/<application>_test]]></c> containing the .spec file
- and all test suites and data directories for the
- application. Note that there shall only be one .spec file for
- each application.
- </p>
- <p><c>$TESTROOT/test_server</c> must be the current directory
- when calling the <c>ts:run/*</c> function.
- </p>
- <p>All available tests can be found with <c>ts:tests()</c>. This
- will list all applications for which a test specification file
- <c><![CDATA[../<application>_test/<application>.spec]]></c> can be found.
- </p>
- <p>To run all these tests, use <c>ts:run()</c>.
- </p>
- <p>To run one or some of the tests, use <c>ts:run(Tests)</c>,
- where <c>Tests</c> is the name of the application you want to
- test, or a list of such names.
- </p>
- <p>To run one test suite within a test, use
- <c>ts:run(Test,Suite)</c>.
- </p>
- <p>To run one test case within a suite, use
- <c>ts:run(Test,Suite,Case)</c></p>
- <p>To all these functions, you can also add a list of
- options. Please turn to the reference manual for the <c>ts</c>
- module to see the valid options to use.
- </p>
- <p>The function <c>ts:help()</c> displays some simple help for
- the functions in <c>ts</c>. Use this for quick reference.
- </p>
- <p>LOG FILES</p>
- <p>As the execution of the test suites go on, events are logged in
- four different ways:
- </p>
- <list type="bulleted">
- <item>Text to the operator's console.</item>
- <item>Suite related information is sent to the major log file.</item>
- <item>Case related information is sent to the minor log file.</item>
- <item>The HTML log file gets updated with test results.</item>
- </list>
- <p>Typically the operator, who may run hundreds or thousands of
- test cases, doesn't want to fill the screen with details
- about/from the specific test cases. By default, the operator will
- only see:
- </p>
- <list type="bulleted">
- <item>A confirmation that the test has started.
- </item>
- <item>A small note about each failed test case.
- </item>
- <item>A summary of all the run test cases.
- </item>
- <item>A confirmation that the test run is complete
- </item>
- <item>Some special information like error reports and progress
- reports, printouts written with erlang:display/1 or io:format/3
- specifically addressed to somewhere other than
- <c>standard_io</c>.</item>
- </list>
- <p>This is enough for the operator to know, and if he wants to dig
- in deeper into a specific test case result, he can do so by
- following the links in the HTML presentation to take a look in the
- major or minor log files.
- </p>
- <p>A detailed report of the entire test suite is stored in the
- major logfile, the exact reason for failure, time spent etc.
- </p>
- <p>The HTML log file is a summary of the major log file, but gives
- a much better overview of the test run. It also has links to every
- test case's log file for quick viewing with a HTML browser.
- </p>
- <p>The minor log file contain full details of every single test
- case, each one in a separate file. This way the files should be
- easy to compare with previous test runs, even if the set of test
- cases change.
- </p>
- <p>Which information that goes where is user configurable via the
- test server controller. Three threshold values determine what
- comes out on screen, and in the major or minor log files. The
- contents that goes to the HTML log file is fixed, and cannot be
- altered.
- </p>
-
- </description>
- <funcs>
- <func>
- <name>install() -> ok | {error, Reason}</name>
- <name>install(TargetSystem) -> ok | {error, Reason}</name>
- <name>install(Opts) -> ok | {error, Reason}</name>
- <name>install(TargetSystem,Opts) -> ok | {error, Reason}</name>
- <fsummary>Installs the Test Server Framework</fsummary>
- <type>
- <v>TargetSystem = {Architecture, TargetHost}</v>
- <v>Architecture = atom() or string()</v>
- <d>e.g. "ose" or "vxworks_ppc603"</d>
- <v>TargetHost = atom() or string()</v>
- <d>The name of the target host</d>
- <v>Opts = list()</v>
- </type>
- <desc>
- <p>Installs and configures the Test Server Framework for
- running test suites. If a remote host is to be used, the
- <c>TargetSystem</c> argument must be given so that "cross
- installation" can be done. Installation is required for
- any of the functions in <c>ts</c> to work.
- </p>
- <p>Opts may be one or more of
- </p>
- <list>
- <item><c>{longnames, Bool}</c><br></br>
- Use fully qualified hostnames for test_server and
- slave nodes. Bool is <c>true</c> or <c>false</c> (default).
- </item>
- <item><c>{verbose, Level}</c><br></br>
- Verbosity level for test server output, set to 0, 1 or
- 2, where 0 is quiet(default).
- </item>
- <item><c>{hosts, Hosts}</c><br></br>
- This is a list of available hosts on which to start
- slave nodes. It is used when the <c>{remote, true}</c>
- option is given to the <c>test_server:start_node/3</c>
- function. Also, if <c>{require_nodenames, Num}</c> is
- contained in a test specification file, the generated
- nodenames will be spread over all hosts given in this
- <c>Hosts</c> list. The hostnames are given as atoms or
- strings.
- </item>
- <item><c>{slavetargets, SlaveTarges}</c><br></br>
- For VxWorks only. This is a list of
- available hosts where slave nodes can be started. This is
- necessary because only one node can run per host in the
- VxWorks environment. This is not the same as
- <c>{hosts, Hosts}</c> because it is used for all slave nodes
- - not only the ones started with <c>{remote, true}</c>. The
- hostnames are given as atoms or strings.
- </item>
- <item><c>{crossroot, TargetErlRoot}</c><br></br>
- Erlang root directory on target host
- <br></br>
-This option is mandatory for remote targets
- </item>
- <item><c>{master, {MasterHost, MasterCookie}}</c><br></br>
- If target is remote and the target node is started as
- a slave node, this option
- indicates which master and cookie to use. The given master
- will also be used as master for slave nodes started with
- <c>test_server:start_node/3</c>. It is expected that the
- <c>erl_boot_server</c> is started on the master node before
- the test is run. If this option is not given, the test
- server controller node is used as master and the
- <c>erl_boot_server</c> is automatically started.
- </item>
- <item><c>{erl_start_args, ArgString}</c><br></br>
- Additional arguments to be used when starting the test
- server controller node. <c>ArgString</c> will be appended to
- the command line when starting the erlang node. Note that
- this will only affect the startup of the <em>controller node</em>,
- i.e. not the target node or any slave nodes
- startet from a test case.
- </item>
- <item><c>{ipv6_hosts, HostList}</c><br></br>
- This option will be inserted in the
- <c>Config</c> parameter for each test case. <c>HostList</c>
- is a list of hosts supporting IPv6.
- </item>
- </list>
- </desc>
- </func>
- <func>
- <name>help() -> ok</name>
- <fsummary>Presents simple help on the functions in <c>ts</c></fsummary>
- <desc>
- <p>Presents simple help on the functions in <c>ts</c>. Useful
- for quick reference.</p>
- </desc>
- </func>
- <func>
- <name>tests() -> Tests</name>
- <fsummary>Returns the list of available tests</fsummary>
- <desc>
- <p>Returns the list of available tests. This is actually just
- a list of all test specification files found by looking up
- "../*_test/*.spec".
- </p>
- <p>In each ../Name_test/ directory there should be one test
- specification file named Name.spec.</p>
- </desc>
- </func>
- <func>
- <name>run() -> ok | {error, Reason}</name>
- <name>run([all_tests|Opts])</name>
- <name>run(Specs)</name>
- <name>run(Specs, Opts)</name>
- <name>run(Spec, Module)</name>
- <name>run(Spec, Module, Opts)</name>
- <name>run(Spec, Module, Case)</name>
- <name>run(Spec, Module, Case, Opts)</name>
- <fsummary>Runs (specified) test suite(s)</fsummary>
- <type>
- <v>Specs = Spec | [Spec]</v>
- <v>Spec = atom()</v>
- <v>Module = atom()</v>
- <v>Case = atom()</v>
- <v>Opts = [Opt]</v>
- <v>Opt = batch | verbose | {verbose, Level} | {vars, Vars} | keep_topcase | cover | cover_details |{cover,CoverFile} | {cover_details,CoverFile} | {trace, TraceSpec}</v>
- <v>Level = integer(); 0 means silent</v>
- <v>Vars = list() of key-value tuples</v>
- <v>CoverFile = string(); name of file listing modules to exclude from or include in cover compilation. The name must include full path to the file.</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>This function runs test suite(s)/case(s). To be able to run
- any tests, ts:install must first be called to create the
- <c>variables</c> file needed. To run a whole test specification,
- only specify the name of the test specification, and all test
- suite modules belonging to that test spec will be run. To run
- a single module in a test specification, use the Module
- argument to specify the name of the module to run and all test
- cases in that module will be run, and to run a specified test
- case, specify the name of the test case using the Case
- argument. If called with no argument, all test specifications
- available will be run. Use ts:tests/0 to see the available
- test specifications.
- </p>
- <p>If the <c>batch</c> option is not given, a new xterm is
- started (unix) when <c>ts:run</c> is called.
- </p>
- <p>The <c>verbose</c> option sets the verbosity level for test
- server output. This has the same effect as if given to
- <c>ts:install/1/2</c></p>
- <p>The <c>vars</c> option can be used for adding configuration
- variables that are not in the <c>variables</c> file generated
- during installation. Can be any of the <c>Opts</c> valid for
- <c>ts:install/1/2</c>.
- </p>
- <p>The <c>keep_topcase</c> option forces <c>ts</c> to keep the
- topcase in your test specification file as is. This option can
- only be used if you don't give the <c>Module</c> or
- <c>Case</c> parameters to <c>ts:run</c>. The
- <c>keep_topcase</c> option is necessary if your topcase
- contains anything other than <c><![CDATA[{dir,"../<Name>_test"}]]></c>. If
- the option is not used, <c>ts</c> will modify your topcase.
- </p>
- <p>The <c>cover</c> and <c>cover_details</c> options indicates
- that the test shall be run with code coverage
- analysis. <c>cover_details</c> means that analysis shall be
- done on the most detailed level. If the test is run with a
- remote target, this option creates a list of uncovered lines
- in each cover compiled module. If the test is run with a local
- target, each cover compiled module will be analysed with
- <c>cover:analyse_to_file/1</c>. The <c>cover</c> options will
- only create an overview of all cover compiled modules with the
- number of covered and not covered lines.
- </p>
- <p>The <c>CoverFile</c> which can be given with the
- <c>cover</c> and <c>cover_details</c> options must be the
- filename of a file listing modules to be excluded from or
- included in the cover compilation. By default, <c>ts</c>
- believes that <c>Spec</c> is the name of an OTP application
- and that all modules in this application shall be cover
- compiled. The <c>CoverFile</c> can exclude modules that belong
- to the application and add modules that don't belong to the
- application. The file can have the following entries:</p>
- <code type="none">
-{exclude, all | ExcludeModuleList}.
-{include, IncludeModuleList}. </code>
- <p>Note that each line must end with a full
- stop. <c>ExcludeModuleList</c> and <c>IncludeModuleList</c>
- are lists of atoms, where each atom is a module name.
- </p>
- <p>If the <c>cover</c> or <c>cover_details</c> options are
- given on their own, the directory <c><![CDATA[../<Spec>_test]]></c> is
- searched for a <c>CoverFile</c> named <c><![CDATA[<Spec>.cover]]></c>. If
- this file is not found, <c>Spec</c> is assumed to be the name
- of an OTP application, and all modules in the <c>ebin</c>
- directory for the application are cover compiled. The
- <c>ebin</c> directory is found by adding <c>ebin</c> to
- <c>code:lib_dir(Spec)</c>.
- </p>
- <p>The same cover compiled code will be loaded on all slave or
- peer nodes started with <c>test_server:start_node/3</c>. The
- exception is nodes that run an old version of OTP. If the loading
- fails, the node will simply not be a part of the coverage
- analysis. Note that slave and peer nodes must be stopped with
- <c>test_server:stop_node/1</c> for the node to be part of the
- coverage analysis, else the test server will not be able to
- fetch coverage data from the node.
- </p>
- <p>The <c>trace</c> option is used to turn on call trace on
- target and on slave or peer nodes started with
- <c>test_server:start_node/3</c>. <c>TraceSpec</c> can be the
- name of a trace information file, or a list of elements like
- the ones in a trace information file. Please turn to the
- reference manual for <c>test_server_ctrl:trc/1</c> for details
- about the trace information file.
- </p>
- </desc>
- </func>
- <func>
- <name>cross_cover_analyse(Level) -> ok</name>
- <name>cross_cover_analyse([Level]) -> ok</name>
- <fsummary>Analyse cover data collected from all tests</fsummary>
- <desc>
- <p>Analyse cover data collected from all tests.
- </p>
- <p>See test_server_ctrl:cross_cover_analyse/2
- </p>
- </desc>
- </func>
- <func>
- <name>r() -> ok</name>
- <name>r(Opts) -> ok</name>
- <name>r(SpecOrSuite) -> ok</name>
- <name>r(SpecOrSuite,Opts) -> ok</name>
- <name>r(Suite,Case) -> ok</name>
- <name>r(Suite,Case,Opts) -> ok</name>
- <fsummary>Run test suite or test case without <c>ts</c>installed</fsummary>
- <type>
- <v>SpecOrSuite = Spec | Suite</v>
- <v>Spec = string()</v>
- <d>"Name.spec" or "Name.spec.OsType", where OsType is vxworks</d>
- <v>Suite = atom()</v>
- <v>Case = atom()</v>
- <v>Opts = [Opt]</v>
- <v>Opt = {Cover,AppOrCoverFile} | {Cover,Application,CoverFile}</v>
- <v>Cover = cover | cover_details</v>
- <v>AppOrCoverFile = Application | CoverFile</v>
- <v>Application = atom()</v>
- <d>OTP application to cover compile</d>
- <v>CoverFile = string()</v>
- <d>Name of file listing modules to exclude from or include in cover compilation</d>
- </type>
- <desc>
- <p>This function can be used to run a test suites or test
- cases directly, without any of the additional features added
- by the test server framework. It is simply a wrapper function
- for the <c>add_dir</c>, <c>add_spec</c>, <c>add_module</c> and
- <c>add_case</c> functions in <c>test_server_ctrl</c>:
- </p>
- <p><c>r() -> add_dir(".")</c> <br></br>
-<c>r(Spec) -> add_spec(Spec)</c> <br></br>
-<c>r(Suite) -> add_module(Suite)</c> <br></br>
-<c>r(Suite,Case) -> add_case(Suite,Case)</c></p>
- <p>To use this function, it is required that the test suite is
- compiled and in the code path of the node where the function
- is called. The function can be used without having <c>ts</c>
- installed.
- </p>
- <p>For information about the <c>cover</c> and
- <c>cover_details</c> options, see <c>test_server_ctrl:cover/2/3</c>.</p>
- </desc>
- </func>
- <func>
- <name>estone() -> ok | {error, Reason}</name>
- <name>estone(Opts) -> ok</name>
- <fsummary>Runs the EStone test</fsummary>
- <desc>
- <p>This function runs the EStone test. It is a shortcut for
- running the test suite <c>estone_SUITE</c> in the
- <c>kernel</c> application.
- </p>
- <p><c>Opts</c> is the same as the <c>Opts</c> argument for the
- <c>ts:run</c> functions.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>Makfile.src in Data Directory</title>
- <p>If a data directory contains code which must be compiled before
- the test suite is run, a makefile source called
- <c>Makefile.src</c> can be placed in the data directory. This file
- will be converted to a valid makefile by <c>ts:run/0/1/2/3/4</c>.
- </p>
- <p>The reason for generating the makefile is that you can use
- variables from the <c>variables</c> file which was generated by
- <c>ts:install/0/1/2</c>. All occurrences of <c>@Key@</c> in
- <c>Makefile.src</c> is substituted by the <c>Value</c> from
- <c>{Key,Value}</c> found in the <c>variables</c> file. Example:
- </p>
- <p>Cut from <c>variables</c>:</p>
- <code type="none">
- ...
- {'EMULATOR',"beam"}.
- {'CFLAGS',"-g -O2"}.
- {'LD',"$(CC) $(CFLAGS)"}.
- {'CC',"gcc"}.
- ...
- </code>
- <p><c>Makefile.src</c> for compiling erlang code could look
- something like this:</p>
- <code type="none">
- EFLAGS=+debug_info
-
- all: ordsets1.@EMULATOR@
-
- ordsets1.@EMULATOR@: ordsets1.erl
- erlc $(EFLAGS) ordsets1.erl
- </code>
- <p><c>Makefile.src</c> for compiling c code could look
- something like this:</p>
- <code type="none">
- CC = @CC@
- LD = @LD@
- CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@
- CROSSLDFLAGS = @CROSSLDFLAGS@
-
- PROGS = nfs_check@exe@
-
- all: $(PROGS)
-
- nfs_check@exe@: nfs_check@obj@
- $(LD) $(CROSSLDFLAGS) -o nfs_check nfs_check@obj@ @LIBS@
-
- nfs_check@obj@: nfs_check.c
- $(CC) -c -o nfs_check@obj@ $(CFLAGS) nfs_check.c
- </code>
- </section>
-</erlref>
-
diff --git a/lib/test_server/doc/src/why_test_chapter.xml b/lib/test_server/doc/src/why_test_chapter.xml
deleted file mode 100644
index 3d0e8271b1..0000000000
--- a/lib/test_server/doc/src/why_test_chapter.xml
+++ /dev/null
@@ -1,141 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Why Test</title>
- <prepared>Siri Hansen</prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
-
- <section>
- <title>Goals</title>
- <p>It's not possible to prove that a program is correct by
- testing. On the contrary, it has been formally proven that it is
- impossible to prove programs in general by testing. Theoretical
- program proofs or plain examination of code may be viable options
- for those that wish to certify that a program is correct. The test
- server, as it is based on testing, cannot be used for
- certification. Its intended use is instead to (cost effectively)
- <em>find bugs</em>. A successful test suite is one that reveals a
- bug. If a test suite results in Ok, then we know very little that
- we didn't know before.
- </p>
- </section>
-
- <section>
- <title>What to test?</title>
- <p>There are many kinds of test suites. Some concentrate on
- calling every function in the interface to some module or
- server. Some other do the same, but uses all kinds of illegal
- parameters, and verifies that the server stays alive and rejects
- the requests with reasonable error codes. Some test suites
- simulate an application (typically consisting of a few modules of
- an application), some try to do tricky requests in general, some
- test suites even test internal functions.
- </p>
- <p>Another interesting category of test suites are the ones that
- check that fixed bugs don't reoccur. When a bugfix is introduced,
- a test case that checks for that specific bug should be written
- and submitted to the affected test suite(s).
- </p>
- <p>Aim for finding bugs. Write whatever test that has the highest
- probability of finding a bug, now or in the future. Concentrate
- more on the critical parts. Bugs in critical subsystems are a lot
- more expensive than others.
- </p>
- <p>Aim for functionality testing rather than implementation
- details. Implementation details change quite often, and the test
- suites should be long lived. Often implementation details differ
- on different platforms and versions. If implementation details
- have to be tested, try to factor them out into separate test
- cases. Later on these test cases may be rewritten, or just
- skipped.
- </p>
- <p>Also, aim for testing everything once, no less, no more. It's
- not effective having every test case fail just because one
- function in the interface changed.
- </p>
- </section>
-
- <section>
- <title>How much to test</title>
- <p>There is a unix shell script that counts the number of non
- commented words (lines and characters too) of source code in each
- application's test directory and divides with the number of such
- source words in the src directory. This is a measure of how much
- test code there is.
- </p>
- <p>There has been much debate over how much test code, compared to
- production code, should be written in a project. More test code
- finds more bugs, but test code needs to be maintained just like
- the production code, and it's expensive to write it in the first
- place. In several articles from relatively mature software
- organizations that I have read, the amount of test code has been
- about the same as the production code. </p>
- <p>In OTP, at the time of
- writing, few applications come even close to this, some have no
- test code at all.
- </p>
-
- <section>
- <title>Full coverage</title>
- <p>It is possible to cover compile the modules being tested
- before running the test suites. Doing so displays which branches
- of the code that are tested by the test suite, and which are
- not. Many use this as a measure of a good test suite. When every
- single line of source code is covered once by the test suite,
- the test suite is finished.
- </p>
- <p>A coverage of 100% still proves nothing, though. It doesn't
- mean that the code is error free, that everything is tested. For
- instance, if a function contains a division, it has to be
- executed at least twice. Once with parameters that cause
- division by zero, and once with other parameters.
- </p>
- <p>High degree of coverage is good of course, it means that no
- major parts of the code has been left untested. It's another
- question whether it's cost effective. You're only likely to find
- 50% more bugs when going from 67% to 100% coverage, but the work
- (cost) is maybe 200% as large, or more, because reaching all of
- those obscure branches is usually complicated.
- </p>
- <p>Again, the reason for testing with the test server is to find
- bugs, not to create certificates of valid code. Maximizing the
- number of found bugs per hour probably means not going for 100%
- coverage. For some module the optimum may be 70%, for some other
- maybe 250%. 100% shouldn't be a goal in itself.</p>
- </section>
-
- <section>
- <title>User interface testing</title>
- <p>It is very difficult to do sensible testing of user
- interfaces, especially the graphic ones. The test server has
- some support for capturing the text I/O that goes to the user,
- but none for graphics. There are several tools on the market
- that help with this.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/test_server/doc/src/write_framework_chapter.xml b/lib/test_server/doc/src/write_framework_chapter.xml
deleted file mode 100644
index d10b580c34..0000000000
--- a/lib/test_server/doc/src/write_framework_chapter.xml
+++ /dev/null
@@ -1,160 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Write you own test server framework</title>
- <prepared>Siri Hansen</prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>write_framework_chapter.xml</file>
- </header>
-
- <section>
- <title>Introduction</title>
- <p>The test server controller can be interfaced from the operating
- system or from within Erlang. The nature of your new framework
- will decide which interface to use. If you want your framework to
- start a new node for each test, the operating system interface is
- very convenient. If your node is already started, going from
- within Erlang might be a more flexible solution.
- </p>
- <p>The two methods are described below.
- </p>
- </section>
-
- <section>
- <title>Interfacing the test server controller from Erlang</title>
- <p>Using the test server from Erlang means that you have to start
- the test server and then add test jobs. Use
- <c>test_server_ctrl:start/0</c> to start the test server, and
- <c>test_server_ctrl:stop/0</c> to stop it.
- </p>
-
- <section>
- <title>Adding test jobs</title>
- <p>There are many commands available for adding test cases to
- the test server's job queue: <br></br>
-</p>
- <list type="bulleted">
- <item>Single test case <br></br>
-<c>test_server_ctrl:add_case/2/3</c></item>
- <item>Multiple test cases from same suite <br></br>
-<c>test_server_ctrl:add_cases/2/3</c></item>
- <item>Test suite module or modules <br></br>
-<c>test_server_ctrl:add_module/1/2</c></item>
- <item>Some or all test suite modules in a directory <br></br>
-<c>test_server_ctrl:add_dir/2/3</c></item>
- <item>Test cases specified in a test specification file <br></br>
-<c>test_server_ctrl:add_spec/1</c></item>
- </list>
- <p>All test suites are given a unique name, which is usually
- given when the test suite is added to the job queue. In some
- cases, a default name is used, as in the case when a module is
- added without a specified name. The test job name is used to
- store logfiles, which are stored in the `name.logs' directory
- under the current directory.
- </p>
- <p>See the reference manual for details about the functions for
- adding test jobs.
- </p>
- </section>
- </section>
-
- <section>
- <title>Interfacing the test server controller from the operating system.</title>
- <p>The function <c>run_test/1</c> is your interface in the test
- server controller if you wish to use it from the operating
- system. You simply start an erlang shell and invoke this function
- with the <c>-s</c> option. <c>run_test/1</c> starts the test
- server, runs the test specified by the command line and stops the
- test server. The argument to <c>run_test/1</c> is a list of
- command line flags, typically
- <c>['KEY1', Value1, 'KEY2', Value2, ...]</c>.
- The valid command line flags are listed in the reference manual
- for <c>test_server_ctrl</c>.
- </p>
- <p>A typical command line may look like this <br></br>
-<c>erl -noshell -s test_server_ctrl run_test KEY1 Value1 KEY2 Value2 ... -s erlang halt</c></p>
- <p>Or make an alias (this is for unix/tcsh) <br></br>
-<c>alias erl_test 'erl -noshell -s test_server_ctrl run_test \!* -s erlang halt'</c></p>
- <p>And then use it like this <br></br>
-<c>erl_test KEY1 Value1 KEY2 Value2 ...</c> <br></br>
-</p>
-
- <section>
- <title>An Example</title>
- <p>An example of starting a test run from the command line <br></br>
-</p>
- <p><c>erl -name test_srv -noshell -rsh /home/super/otp/bin/ctrsh </c> <br></br>
-<c>-pa /clearcase/otp/erts/lib/kernel/test </c> <br></br>
-<c>-boot start_sasl -sasl errlog_type error </c> <br></br>
-<c>-s test_server_ctrl run_test SPEC kernel.spec -s erlang halt</c> <br></br>
-</p>
- </section>
- </section>
-
- <section>
- <title>Framework callback functions</title>
- <p>By defining the environment variable
- <c>TEST_SERVER_FRAMEWORK</c> to a module name, the framework
- callback functions can be used. The framework callback functions
- are called by the test server in order let the framework interact
- with the execution of the tests and to keep the framework upto
- date with information about the test progress.
- </p>
- <p>The framework callback functions are described in the reference
- manual for <c>test_server_ctrl</c>.
- </p>
- <p>Note that this topic is in an early stage of development, and
- changes might occur.
- </p>
- </section>
-
- <section>
- <title>Other concerns</title>
- <p>Some things to think about when writing you own test server
- framework:
- </p>
- <list type="bulleted">
- <item><c>emulator version</c> - Make sure that the intended
- version of the emulator is started.
- </item>
- <item><c>operating system path</c> - If test cases use port
- programs, make sure the paths are correct.
- </item>
- <item><c>recompilation</c> - Make sure all test suites are fresh
- compiled.
- </item>
- <item><c>test_server.hrl</c> - Make sure the
- <c>test_server.hrl</c> file is in the include path when
- compiling test suites.
- </item>
- <item><c>running applications</c> - Some test suites require
- some applications to be running (e.g. sasl). Make sure they are
- started.
- </item>
- </list>
- </section>
-</chapter>
-
diff --git a/lib/test_server/doc/src/write_test_chapter.xml b/lib/test_server/doc/src/write_test_chapter.xml
deleted file mode 100644
index c3e1881b8a..0000000000
--- a/lib/test_server/doc/src/write_test_chapter.xml
+++ /dev/null
@@ -1,228 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2002</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Writing Test Suites</title>
- <prepared>Siri Hansen</prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>write_test_chapter.xml</file>
- </header>
-
- <section>
- <title>Support for test suite authors</title>
- <p>The <c>test_server</c> module provides some useful functions
- to support the test suite author. This includes:
- </p>
- <list type="bulleted">
- <item>Starting and stopping slave or peer nodes</item>
- <item>Capturing and checking stdout output</item>
- <item>Retrieving and flushing process message queue</item>
- <item>Watchdog timers</item>
- <item>Checking that a function crashes</item>
- <item>Checking that a function succeeds at least m out of n times</item>
- <item>Checking .app files</item>
- </list>
- <p>Please turn to the reference manual for the <c>test_server</c>
- module for details about these functions.
- </p>
- </section>
-
- <section>
- <title>Test suites</title>
- <p>A test suite is an ordinary Erlang module that contains test
- cases. It's recommended that the module has a name on the form
- *_SUITE.erl. Otherwise, the directory function will not find the
- modules (by default).
- </p>
- <p>For some of the test server support, the test server include
- file <c>test_server.hrl</c> must be included. Never include it
- with the full path, for portability reasons. Use the compiler
- include directive instead.
- </p>
- <p>The special function <c>all(suite)</c> in each module is called
- to get the test specification for that module. The function
- typically returns a list of test cases in that module, but any
- test specification could be returned. Please see the chapter
- about test specifications for details about this.
- </p>
- </section>
-
- <section>
- <title>Init per test case</title>
- <p>In each test suite module, the functions
- <c>init_per_testcase/2</c> and <c>end_per_testcase/2</c> must be
- implemented.
- </p>
- <p><c>init_per_testcase</c> is called before each test case in the
- test suite, giving a (limited) possibility for initialization.
- </p>
- <p><c>end_per_testcase/2</c> is called after each test case is
- completed, giving a possibility to clean up.
- </p>
- <p>The first argument to these functions is the name of the test
- case. This can be used to do individual initialization and cleanup for
- each test cases.
- </p>
- <p>The second argument is a list of tuples called
- <c>Config</c>. The first element in a <c>Config</c> tuple
- should be an atom - a key value to be used for searching.
- <c>init_per_testcase/2</c> may modify the <c>Config</c>
- parameter or just return it as is. Whatever is retuned by
- <c>init_per_testcase/2</c> is given as <c>Config</c> parameter to
- the test case itself.
- </p>
- <p>The return value of <c>end_per_testcase/2</c> is ignored by the
- test server.
- </p>
- </section>
-
- <section>
- <title>Test cases</title>
- <p>The smallest unit that the test server is concerned with is a
- test case. Each test case can in turn test many things, for
- example make several calls to the same interface function with
- different parameters.
- </p>
- <p>It is possible to put many or few tests into each test
- case. How many things each test case tests is up to the author,
- but here are some things to keep in mind.
- </p>
- <p>Very small test cases often leads to more code, since
- initialization has to be duplicated. Larger code, especially with
- a lot of duplication, increases maintenance and reduces
- readability.
- </p>
- <p>Larger test cases make it harder to tell what went wrong if it
- fails, and force us to skip larger portions of test code if a
- specific part fails. These effects are accentuated when running on
- multiple platforms because test cases often have to be skipped.
- </p>
- <p>A test case generally consists of three parts, the
- documentation part, the specification part and the execution
- part. These are implemented as three clauses of the same function.
- </p>
- <p>The documentation clause matches the argument '<c>doc</c>' and
- returns a list for strings describing what the test case tests.
- </p>
- <p>The specification clause matches the argument '<c>suite</c>'
- and returns the test specification for this particular test
- case. If the test specification is an empty list, this indicates
- that the test case is a leaf test case, i.e. one to be executed.
- </p>
- <p>The execution clause implements the actual test case. It takes
- one argument, <c>Config</c>, which contain configuration
- information like <c>data_dir</c> and <c>priv_dir</c>. See <seealso marker="#data_priv_dir">Data and Private Directories</seealso> for
- more information about these.
- </p>
- <p>The <c>Config</c> variable can also contain the
- <c>nodenames</c> key, if requested by the <c>require_nodenames</c>
- command in the test suite specification file. All <c>Config</c>
- items should be extracted using the <c>?config</c> macro. This is
- to ensure future compatibility if the <c>Config</c> format
- changes. See the reference manual for <c>test_server</c> for
- details about this macro.
- </p>
- <p>If the execution clause crashes or exits, it is considered a
- failure. If it returns <c>{skip,Reason}</c>, the test case is
- considered skipped. If it returns <c>{comment,String}</c>,
- the string will be added in the 'Comment' field on the HTML
- result page. If the execution clause returns anything else, it is
- considered a success, unless it is <c>{'EXIT',Reason}</c> or
- <c>{'EXIT',Pid,Reason}</c> which can't be distinguished from a
- crash, and thus will be considered a failure.
- </p>
- </section>
-
- <section>
- <marker id="data_priv_dir"></marker>
- <title>Data and Private Directories</title>
- <p>The data directory (<c>data_dir</c>) is the directory where the test
- module has its own files needed for the testing. A compiler test
- case may have source files to feed into the compiler, a release
- upgrade test case may have some old and new release of
- something. A graphics test case may have some icons and a test
- case doing a lot of math with bignums might store the correct
- answers there. The name of the <c>data_dir</c> is the the name of
- the test suite and then "_data". For example,
- <c>"some_path/foo_SUITE.beam"</c> has the data directory
- <c>"some_path/foo_SUITE_data/"</c>.
- </p>
- <p>The <c>priv_dir</c> is the test suite's private directory. This
- directory should be used when a test case needs to write to
- files. The name of the private directory is generated by the test
- server, which also creates the directory.
- </p>
- <p><em>Warning:</em> Do not depend on current directory to be
- writable, or to point to anything in particular. All scratch files
- are to be written in the <c>priv_dir</c>, and all data files found
- in <c>data_dir</c>. If the current directory has to be something
- specific, it must be set with <c>file:set_cwd/1</c>.
- </p>
- </section>
-
- <section>
- <title>Execution environment</title>
- <p>Each time a test case is about to be executed, a new process is
- created with <c>spawn_link</c>. This is so that the test case will
- have no dependencies to earlier tests, with respect to process flags,
- process links, messages in the queue, other processes having registered
- the process, etc. As little as possible is done to change the initial
- context of the process (what is created by plain spawn). Here is a
- list of differences:
- </p>
- <list type="bulleted">
- <item>It has a link to the test server. If this link is removed,
- the test server will not know when the test case is finished,
- just wait infinitely.
- </item>
- <item>It often holds a few items in the process dictionary, all
- with names starting with '<c>test_server_</c>'. This is to keep
- track of if/where a test case fails.
- </item>
- <item>There is a top-level catch. All of the test case code is
- catched, so that the location of a crash can be reported back to
- the test server. If the test case process is killed by another
- process (thus the catch code is never executed) the test server
- is not able to tell where the test case was executing.
- </item>
- <item>It has a special group leader implemented by the test
- server. This way the test server is able to capture the io that
- the test case provokes. This is also used by some of the test
- server support functions.
- </item>
- </list>
- <p>There is no time limit for a test case, unless the test case
- itself imposes such a limit, by calling
- <c>test_server:timetrap/1</c> for example. The call can be made
- in each test case, or in the <c>init_per_testcase/2</c>
- function. Make sure to call the corresponding
- <c>test_server:timetrap_cancel/1</c> function as well, e.g in the
- <c>end_per_testcase/2</c> function, or else the test cases will
- always fail.
- </p>
- </section>
-
-</chapter>
-
diff --git a/lib/test_server/ebin/.gitignore b/lib/test_server/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/test_server/ebin/.gitignore
+++ /dev/null
diff --git a/lib/test_server/include/test_server.hrl b/lib/test_server/include/test_server.hrl
deleted file mode 100644
index 77864ef3b5..0000000000
--- a/lib/test_server/include/test_server.hrl
+++ /dev/null
@@ -1,32 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
--ifdef(line_trace).
--line_trace(true).
--define(line,
- io:format(lists:concat([?MODULE,",",integer_to_list(?LINE),": ~p"]),
- [erlang:monotonic_time()-erlang:system_info(start_time)]),).
--else.
--define(line,).
--endif.
--define(t,test_server).
--define(config,test_server:lookup_config).
-
-
diff --git a/lib/test_server/include/test_server_line.hrl b/lib/test_server/include/test_server_line.hrl
deleted file mode 100644
index 37da956cd0..0000000000
--- a/lib/test_server/include/test_server_line.hrl
+++ /dev/null
@@ -1,20 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
diff --git a/lib/test_server/info b/lib/test_server/info
deleted file mode 100644
index 7a9ed6c700..0000000000
--- a/lib/test_server/info
+++ /dev/null
@@ -1,2 +0,0 @@
-group: test Test Applications
-short: The OTP Test Server
diff --git a/lib/test_server/prebuild.skip b/lib/test_server/prebuild.skip
deleted file mode 100644
index 8ee4101f6a..0000000000
--- a/lib/test_server/prebuild.skip
+++ /dev/null
@@ -1 +0,0 @@
-src/autom4te.cache
diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile
deleted file mode 100644
index 6a26ee2933..0000000000
--- a/lib/test_server/src/Makefile
+++ /dev/null
@@ -1,144 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1996-2013. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-include $(ERL_TOP)/make/target.mk
-
-# ----------------------------------------------------
-# Configuration info.
-# ----------------------------------------------------
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(TEST_SERVER_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/test_server-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= test_server_ctrl \
- test_server_gl \
- test_server_io \
- test_server_node \
- test_server \
- test_server_sup \
- erl2html2
-
-TS_MODULES= \
- ts \
- ts_run \
- ts_lib \
- ts_make \
- ts_erl_config \
- ts_autoconf_win32 \
- ts_install \
- ts_install_cth \
- ts_benchmark
-
-TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
-TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%)
-
-ERL_FILES= $(MODULES:=.erl)
-TS_ERL_FILES= $(TS_MODULES:=.erl)
-HRL_FILES = ../include/test_server.hrl ../include/test_server_line.hrl
-INTERNAL_HRL_FILES = test_server_internal.hrl
-TS_HRL_FILES= ts.hrl
-C_FILES =
-AUTOCONF_FILES = configure.in conf_vars.in
-PROGRAMS = configure config.sub config.guess install-sh
-CONFIG = ts.config ts.unix.config ts.win32.config
-
-TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \
- $(APP_TARGET) $(APPUP_TARGET)
-TS_TARGET_FILES = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-TARGETS = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(PROGRAMS) \
- $(APP_TARGET) $(APPUP_TARGET)
-TS_TARGETS = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-APP_FILE= test_server.app
-APP_SRC= $(APP_FILE).src
-APP_TARGET= $(EBIN)/$(APP_FILE)
-
-APPUP_FILE= test_server.appup
-APPUP_SRC= $(APPUP_FILE).src
-APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_COMPILE_FLAGS += -I../include -Werror
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-tests debug opt: $(TARGETS) $(TS_TARGETS)
-
-clean:
- rm -f $(TARGET_FILES) $(TS_TARGET_FILES)
- rm -f core
-
-docs:
-
-configure: configure.in
- autoconf configure.in > configure
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-$(APP_TARGET): $(APP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include"
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin"
-
-release_tests_spec: opt
- $(INSTALL_DIR) "$(RELEASE_PATH)/test_server"
- $(INSTALL_DATA) $(ERL_FILES) $(TS_ERL_FILES) \
- $(HRL_FILES) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) \
- $(TS_TARGET_FILES) \
- $(AUTOCONF_FILES) $(C_FILES) $(CONFIG) \
- "$(RELEASE_PATH)/test_server"
- $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server"
-
-release_docs_spec:
-
diff --git a/lib/test_server/src/things/distr_startup_SUITE.erl b/lib/test_server/src/things/distr_startup_SUITE.erl
deleted file mode 100644
index aa84ab007f..0000000000
--- a/lib/test_server/src/things/distr_startup_SUITE.erl
+++ /dev/null
@@ -1,239 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(distr_startup_SUITE).
--compile([export_all]).
-%%-define(line_trace,1).
--include("test_server.hrl").
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all(suite) -> [reads,writes].
-
--define(iterations,10000).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-app1() ->
- {application, app1,
- [{description, "ERTS CXC 138 10"},
- {vsn, "2.0"},
- {applications, [kernel, stdlib]},
- {mod, {ch_sup, {app1, 1, 3}}}]}.
-
-app3() ->
- {application, app3,
- [{description, "ERTS CXC 138 10"},
- {vsn, "2.0"},
- {applications, [kernel, stdlib]},
- {mod, {ch_sup, {app3, 7, 9}}}]}.
-
-
-config(Fd,C1,C2,C3) ->
- io:format(Fd,
- "[{kernel, [{sync_nodes_optional, ['~s','~s','~s']},"
- "{sync_nodes_timeout, 1},"
- "{distributed, [{app1, ['~s', '~s', '~s']},"
- "{app2, 10000, ['~s', '~s', '~s']},"
- "{app3, 5000, [{'~s', '~s'}, '~s']}]}]}].~n",
- [C1,C2,C3, C1,C2,C3, C1,C2,C3, C1,C2,C3]).
-
-from(H, [H | T]) -> T;
-from(H, [_ | T]) -> from(H, T);
-from(H, []) -> [].
-
-%%-----------------------------------------------------------------
-%% Test suite for distributed applications, tests start, load
-%% etc indirectly.
-%% Should be started in a CC view with:
-%% erl -sname master -rsh ctrsh
-%%-----------------------------------------------------------------
-start_nodes(Conf) ->
- % Write a config file
- ?line Nodes = ?config(nodes,Conf),
- ?line [C1,C2,C3|_] = Nodes, %% Need at least 3 nodes
- ?line Dir = ?config(priv_dir,Conf),
- ?line {ok, Fd} = file:open(Dir ++ "sys.config", write),
- ?line config(Fd,C1,C2,C3),
- ?line file:close(Fd),
- ?line Config = Dir ++ "sys",
-
- % Test [cp1, cp2, cp3]
- ?line {ok, Cp1} = start_node(lists:nth(1,Nodes), Config),
- ?line {ok, Cp2} = start_node(lists:nth(2,Nodes), Config),
- ?line {ok, Cp3} = start_node(lists:nth(3,Nodes), Config),
- % Start app1 and make sure cp1 starts it
- %%?line rpc:multicall([Cp1, Cp2, Cp3], application, load, [app1()]),
- %%?line rpc:multicall([Cp1, Cp2, Cp3], application, start,[app1,permanent]),
- ?line test_server:sleep(1000),
- {Cp1,Cp2,Cp3}.
-
-stop_nodes({Cp1,Cp2,Cp3}) ->
- ?line stop_node(Cp1),
- ?line stop_node(Cp2),
- ?line stop_node(Cp3).
-
-start_node(NodeAtHost, Config) ->
- ?line NodeAtHostStr = atom_to_list(NodeAtHost),
- ?line HostStr = from($@,NodeAtHostStr),
- ?line NodeStr = lists:reverse(from($@,lists:reverse(NodeAtHostStr))),
- ?line Host = list_to_atom(HostStr),
- ?line Node = list_to_atom(NodeStr),
- ?line io:format("Launching slave node ~p@~p ~p",[Node,Host,Config]),
- ?line slave:start(Host, Node, lists:concat(["-config ", Config])).
-
-stop_node(Node) ->
- ?line rpc:cast(Node, erlang, halt, []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-start_client_process(Cp,Mode,NodeNum) ->
- io:format("Starting client process at ~p in mode ~p",[Cp,Mode]),
- ?line case rpc:call(Cp, erlang, spawn,
- [?MODULE, client,
- [Mode,NodeNum,self(),random:uniform(1000)]]) of
- {badrpc,Reason} ->
- ?line exit({badrpc,{Cp,Reason}});
- Client ->
- ?line Client
- end.
-
-start_clients(Mode,Conf) ->
- ?line random:seed(4711,0,0),
- ?line {Cp1,Cp2,Cp3} = start_nodes(Conf),
- ?line Client1 = start_client_process(Cp1,Mode,1),
- ?line Client2 = start_client_process(Cp2,Mode,2),
- ?line Client3 = start_client_process(Cp3,Mode,3),
- test_server:format(1,"All 3 nodes started, "
- "power off client(s) any time...",[]),
- Client1 ! go,
- Client2 ! go,
- Client3 ! go,
- {{Cp1,Cp2,Cp3},{Client1,Client2,Client3}}.
-
-stop_clients(Cps) ->
- test_server:format(1,"Test completed.",[]),
- ?line stop_nodes(Cps).
-
-data() ->
- {{self(),foo,bar,[1,2,3,4,5,6,7],{{{{}}}},
- "We need pretty long packages, so that there is a big risk "
- "of cutting it in the middle when suddenly turning off "
- "the power or breaking the connection. "
- "We don't check the contents of the data very much, but "
- "at least there is a magic cookie at the end (123456)."
- "If that one arrives correctly, the link is ok as far "
- "as we are concerned."},
- 123456}.
-
-reads(suite) -> [];
-reads(Conf) ->
- ?line {Cps,_} = start_clients(w,Conf),
- ?line read_loop(?iterations,0),
- ?line stop_clients(Cps),
- ok.
-
-read_loop(0,M) ->
- ok;
-read_loop(N,M) ->
- ?line Dog = test_server:timetrap(test_server:seconds(0.5)),
- M2 =
- receive
- {Node,Count,{_,123456}} ->
- ?line setelement(Node,M,element(Node,M)+1);
- {Node,Count,Data} ->
- ?line exit({network_transmission_error,Data});
- {nodedown,Node} ->
- ?line test_server:format(1,"Node ~s went down",[Node]),
- ?line M;
- Other ->
- ?line M
- after test_server:seconds(0.1) ->
- ?line io:format("No message!"),
- ?line M
- end,
- ?line test_server:timetrap_cancel(Dog),
- ?line M3 =
- case N rem 100 of
- 0 -> io:format("~p reads to go (~w msgs)",[N,M2]),
- {0,0,0};
- _ -> M2
- end,
- ?line read_loop(N-1,M3).
-
-client(w,NodeNum,Pid,Seed) ->
- random:seed(Seed,0,0),
- receive
- go -> ok
- end,
- client_write_loop(Pid,0,NodeNum,data());
-client(r,NodeNum,Pid,Seed) ->
- random:seed(Seed,0,0),
- receive
- go -> ok
- end,
- client_read_loop(0).
-
-client_write_loop(Pid,N,NodeNum,Data) ->
- test_server:sleep(random:uniform(20)),
- Pid ! {NodeNum,N,Data},
- client_write_loop(Pid,N+1,NodeNum,Data).
-
-writes(suite) -> [];
-writes(Conf) ->
- ?line {Cps,{C1,C2,C3}} = start_clients(r,Conf),
- ?line write_loop(2*?iterations,{C1,C2,C3},data()),
- ?line stop_clients(Cps),
- ok.
-
-write_loop(0,_,_) ->
- ok;
-write_loop(N,Clients,Data) ->
- ?line Dog = test_server:timetrap(test_server:seconds(0.5)),
- ?line Client = element(random:uniform(size(Clients)),Clients),
- ?line Client ! {node(),N,Data},
- ?line test_server:timetrap_cancel(Dog),
- receive
- {nodedown,Node} ->
- ?line test_server:format(1,"Node ~s went down",[Node])
- after 0 ->
- ?line ok
- end,
- ?line case N rem 100 of
- 0 -> io:format("~p writes to go",[N]);
- _ -> ok
- end,
- ?line write_loop(N-1,Clients,Data).
-
-client_read_loop(N) ->
- receive
- {Node,Count,{_,123456}} ->
- ?line ok;
- {Node,Count,Data} ->
- ?line io:format("~p(~p): transmission error from node ~p(~p): ~p",
- [node(),N,Node,Count,Data]);
- Other ->
- ?line io:format("~p(~p): got a strange message: ~p",
- [node(),N,Other])
- end,
- client_read_loop(N+1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/test_server/src/things/mnesia_power_SUITE.erl b/lib/test_server/src/things/mnesia_power_SUITE.erl
deleted file mode 100644
index e9bc75e583..0000000000
--- a/lib/test_server/src/things/mnesia_power_SUITE.erl
+++ /dev/null
@@ -1,126 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(mnesia_power_SUITE).
--compile([export_all]).
-%%-define(line_trace,1).
--include("test_server.hrl").
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all(suite) -> [run].
-
--define(iterations,3). %% nof power-off cycles to do before acceptance
--define(rows,8). %% nof database rows to use (not too big, please)
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--record(sum_table_1,{row,a,b,c,s}).
-
-run(suite) -> [];
-run(Config) ->
- ?line mnesia:create_schema([node()]),
- ?line mnesia:start(),
- ?line mnesia:create_table([{name, sum_table_1}, {disc_copies,[node()]},
- {attributes,record_info(fields,sum_table_1)}]),
- ?line run_test(Config,?iterations).
-
-run(Config,N) ->
- ?line mnesia:start(),
- ?line check_consistency(sum_table_1),
- case N of
- 0 -> ?line ok;
- N -> ?line run_test(Config,N)
- end.
-
-run_test(Config,N) ->
- ?line Pid1a = start_manipulator(sum_table_1),
- ?line Pid1b = start_manipulator(sum_table_1),
- ?line Pid1c = start_manipulator(sum_table_1),
- ?line test_server:resume_point(?MODULE,run,[Config,N-1]),
- ?line test_server:format(1,"Manipulating data like crazy now, "
- "power off any time..."),
- ?line test_server:sleep(infinity).
-
-start_manipulator(Table) ->
- ?line spawn_link(?MODULE,manipulator_init,[Table]).
-
-manipulator_init(Table) ->
- random:seed(4711,0,0),
- manipulator(0,Table).
-
-manipulator(N,Table) ->
- ?line Fun =
- fun() ->
- ?line Row = random:uniform(?rows),
- ?line A = random:uniform(100000),
- ?line B = random:uniform(100000),
- ?line C = random:uniform(100000),
- ?line Sum = A+B+C,
- ?line case mnesia:write(#sum_table_1
- {row=Row,a=A,b=B,c=C,s=Sum}) of
- ok -> ok;
- Other ->
- ?line io:format("Trans failed: ~p\n",[Other])
- end
- end,
- ?line mnesia:transaction(Fun),
- case mnesia:table_info(sum_table_1,size) of
- 0 -> exit(still_empty);
- _ -> ok
- end,
- case N rem 2000 of
- 0 -> io:format("~p did ~p operations",[self(),N]),
- check_consistency(sum_table_1);
- _ -> ok
- end,
- ?line manipulator(N+1,Table).
-
-check_consistency(Table) ->
- io:format("Checking consistency of table ~p\n",[Table]),
- All = mnesia:table_info(Table,wild_pattern),
- ?line Fun =
- fun() ->
- mnesia:match_object(All)
- end,
- ?line case mnesia:transaction(Fun) of
- {atomic,Val} ->
- check_consistency_rows(Val,0);
- Other ->
- io:format("Trans failed: ~p\n",[Other]),
- exit(failed),
- check_consistency(Table)
- end.
-
-check_consistency_rows([#sum_table_1{a=A,b=B,c=C,s=Sum}|Rows],N) ->
- ?line Sum=A+B+C,
- ?line check_consistency_rows(Rows,N+1);
-check_consistency_rows([],N) ->
- io:format("All ~p rows were consistent\n",[N]),
- {ok,N};
-check_consistency_rows(Thing,N) ->
- io:format("Mnesia transaction returned:\n~p\n",[Thing]),
- exit({bad_format,Thing}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
-
-
-
diff --git a/lib/test_server/src/things/random_kill_SUITE.erl b/lib/test_server/src/things/random_kill_SUITE.erl
deleted file mode 100644
index 917bc2b3d5..0000000000
--- a/lib/test_server/src/things/random_kill_SUITE.erl
+++ /dev/null
@@ -1,82 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(random_kill_SUITE).
--compile([export_all]).
-%%-define(line_trace,1).
--include("test_server.hrl").
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-all(suite) -> [run].
-
--define(iterations,25). %% Kill this many processes,
- %% possibly with reboots in between
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-run(suite) -> [];
-run(Config) ->
- registered(?iterations).
-
-registered(0) ->
- ok;
-registered(N) ->
- random:seed(3461*N,1159*N,351*N),
- Pid = select_victim(registered),
- test_server:resume_point(?MODULE,registered,[N-1]),
- test_server:format("About to kill pid ~p (~p)\n~p",
- [Pid,process_info(Pid,registered_name),info(Pid)]),
- %%exit(Pid,kill),
- registered(N-1).
-
-info(Pid) ->
- Rest0 = tl(pid_to_list(Pid)),
- {P1,Rest1} = get_until($.,Rest0),
- {P2,Rest2} = get_until($.,Rest1),
- {P3,_} = get_until($>,Rest2),
- c:i(list_to_integer(P1),list_to_integer(P2),list_to_integer(P3)).
-
-get_until(Ch,L) ->
- get_until(Ch,L,[]).
-get_until(Ch,[],Acc) ->
- {lists:reverse(Acc),[]};
-get_until(Ch,[Ch|T],Acc) ->
- {lists:reverse(Acc),T};
-get_until(Ch,[H|T],Acc) ->
- get_until(Ch,T,[H|Acc]).
-
-select_victim(registered) ->
- Pids =
- lists:map(fun(Server)-> whereis(Server) end,registered()),
- ImmunePids =
- [self()|lists:map(fun(Job)-> element(2,Job) end,test_server:jobs())],
- SuitablePids =
- lists:filter(fun(Pid)-> case lists:member(Pid,ImmunePids) of
- true -> false;
- false -> true
- end
- end, Pids),
- Selected = random:uniform(length(SuitablePids)),
- io:format("Selected ~p if ~p",[Selected,length(SuitablePids)]),
- lists:nth(Selected,SuitablePids).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
diff --git a/lib/test_server/src/things/soft.gs.txt b/lib/test_server/src/things/soft.gs.txt
deleted file mode 100644
index ec57884997..0000000000
--- a/lib/test_server/src/things/soft.gs.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-6> gs:start().
-RealTimeViolation, 478ms (after 1164 good)
-{1,<0.65.0>}
-RealTimeViolation, 352ms (after 0 good)
-RealTimeViolation, 492ms (after 0 good)
-RealTimeViolation, 166ms (after 0 good)
-RealTimeInfo, 18ms (after 7 good)
-RealTimeViolation, 115ms (after 13 good)
-7> application-specific initialization failed: couldn't connect to display ":0.0"
-RealTimeViolation, 20340ms (after 0 good)
-gs error: user backend died reason {port_handler,#Port,normal}
-
-RealTimeInfo, 31ms (after 21 good)
-RealTimeInfo, 21ms (after 69 good)
-RealTimeInfo, 21ms (after 119 good)
-RealTimeInfo, 21ms (after 169 good)
diff --git a/lib/test_server/src/things/verify.erl b/lib/test_server/src/things/verify.erl
deleted file mode 100644
index b09d0fbda9..0000000000
--- a/lib/test_server/src/things/verify.erl
+++ /dev/null
@@ -1,200 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(verify).
-
--export([dir/0, dir/1]).
-
-%% usage verify:dir()
-%% or verify:dir(Dir)
-%%
-%% runs tests on all files with the extension ".t1"
-%% creates an error log file verify.log in the directory where the
-%% tests were run
-
--import(lists, [reverse/1, foldl/3, map/2]).
-
-dir() ->
- dir(".").
-
-dir(Dir) ->
- case file:list_dir(Dir) of
- {ok, Files} ->
- VFiles = collect_vers(Files, []),
- VFiles1 = map(fun(F) -> Dir ++ "/" ++ F end, VFiles),
- Nerrs = foldl(fun(F, Sum) ->
- case file(F) of
- {file,_,had,N,errors} ->
- Sum + N;
- no_errors ->
- Sum;
- Other ->
- Sum + 1
- end
- end, 0, VFiles1),
- case Nerrs of
- 0 -> no_errors;
- _ -> {dir,Dir,had,Nerrs,errors}
- end;
- _ ->
- {error, cannot,list_dir, Dir}
- end.
-
-collect_vers([H|T], L) ->
- case reverse(H) of
- [$1,$t,$.|T1] -> collect_vers(T, [reverse(T1)|L]);
- _ -> collect_vers(T, L)
- end;
-collect_vers([], L) ->
- L.
-
-file(File) ->
- case file:open(File ++ ".t1", read) of
- {ok, S} ->
- io:format("Verifying: ~s\n", [File]),
- ErrFile = File ++ ".errs",
- {ok, E} = file:open(ErrFile, write),
- Bind0 = erl_eval:new_bindings(),
- NErrs = do(S, {E, File, Bind0, 0}, 1),
- file:close(S),
- file:close(E),
- case NErrs of
- 0 ->
- file:delete(ErrFile),
- no_errors;
- _ ->
- {file,File,had,NErrs,errors}
- end;
- _ ->
- error_in_opening_file
- end.
-
-do(S, Env, Line) ->
- R = io:scan_erl_exprs(S, '', Line),
- do1(R, S, Env).
-
-do1({eof,_}, _, {_,_,_,NErrs}) ->
- NErrs;
-do1({ok,Toks,Next}, S, Env0) ->
- E1 = handle_toks(Toks, Next, Env0),
- do(S, E1, Next);
-do1({error, {Line,Mod,Args}, Next}, S, E) ->
- io:format("*** ~w ~p~n", [Line,Mod:format_error(Args)]),
- E1 = add_error(E),
- do(S, E1, Next).
-
-add_error({Stream, File, Bindings, N}) -> {Stream, File, Bindings, N+1}.
-
-handle_toks(Toks, Line, Env0) ->
- %% io:format("Toks:~p\n", [Toks]).
- case erl_parse:parse_exprs(Toks) of
- {ok, Exprs} ->
- %% io:format("Got:~p\n", [Exprs]),
- eval(Exprs, Line, Env0);
- {error, {LineNo, Mod, What}} ->
- Str = apply(Mod, format_error, [What]),
- io:format("*** Line:~w ***~s\n", [LineNo, Str]),
- add_error(Env0);
- Parse_error ->
- io:format("Parse Error:~p\n",[Parse_error]),
- add_error(Env0)
- end.
-
-forget([{var,_,Name}], B0) -> erl_eval:del_binding(Name, B0);
-forget([], _) -> erl_eval:new_bindings().
-
-eval([{call,_,{atom,_,f}, Args}], _, {Stream, Bind0, Errs}) ->
- Bind1 = forget(Args, Bind0),
- {Stream, Bind1, Errs};
-eval(Exprs, Line, {Stream, File, Bind0, NErrs}) ->
- %% io:format("Bindings >> ~p\n", [Bind0]),
- %% io:format("Exprs >> ~p\n", [Exprs]),
- case catch erl_eval:exprs(Exprs, Bind0) of
- {'EXIT', Reason} ->
- out_both(Stream, "----------------------------------~n", []),
- out_both(Stream, "File:~s Error in:~s~n", [File, pp(Exprs)]),
- print_bindings(Stream, Exprs, Bind0),
- print_lhs(Stream, Exprs),
- out_both(Stream, '*** Rhs evaluated to:~p~n',[rhs(Exprs, Bind0)]),
- {Stream, File, Bind0, NErrs+1};
- {value, _, Bind1} ->
- {Stream, File, Bind1, NErrs}
- end.
-
-pp([H]) -> erl_pp:expr(H);
-pp([H|T]) -> [erl_pp:expr(H),$,|pp(T)];
-pp([]) -> [].
-
-print_bindings(E, Form, Bindings) ->
- case varsin(Form) of
- [] ->
- true;
- Vars ->
- print_vars(E, Vars, Bindings)
- end.
-
-print_vars(E, [Var|T], Bindings) ->
- case erl_eval:binding(Var, Bindings) of
- {value, Val} ->
- out_both(E, '~s = ~p\n',[Var, Val]);
- unbound ->
- out_both(E, '~s *is unbound*\n', [Var])
- end,
- print_vars(E, T, Bindings);
-print_vars(_, [], _) ->
- true.
-
-
-out_both(E, Format, Data) ->
- io:format(Format, Data),
- io:format(E, Format, Data).
-
-print_lhs(E, [{match, _, Lhs, Rhs}]) ->
- %% io:format(">>>> here:~w\n",[Lhs]),
- out_both(E, '*** Lhs was:~s\n',[erl_pp:expr(Lhs)]);
-print_lhs(E, _) ->
- out_both(E, '** UNDEFINED **', []).
-
-
-rhs([{match, _, Lhs, Rhs}], Bindings) ->
- case catch erl_eval:exprs([Rhs], Bindings) of
- {value, Val, _} -> Val;
- Other -> undefined()
- end;
-rhs(_, _) ->
- undefined().
-
-varsin(X) -> varsin(X, []).
-
-varsin({var,_,'_'}, L) ->
- L;
-varsin({var,_,V}, L) ->
- case lists:member(V, L) of
- true -> L;
- false -> [V|L]
- end;
-varsin([H|T], L) ->
- varsin(T, varsin(H, L));
-varsin(T, L) when tuple(T) ->
- varsin(tuple_to_list(T), L);
-varsin(_, L) ->
- L.
-
-undefined() ->
- '** UNDEFINED **'.
diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile
deleted file mode 100644
index 8eec940505..0000000000
--- a/lib/test_server/test/Makefile
+++ /dev/null
@@ -1,92 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2012. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= \
- test_server_SUITE \
- test_server_test_lib \
- erl2html2_SUITE
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-INSTALL_PROGS= $(TARGET_FILES)
-
-EMAKEFILE=Emakefile
-COVERFILE=test_server.cover
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/test_server_test
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-
-ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/test
-
-EBIN = .
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-.PHONY: make_emakefile
-
-make_emakefile:
- $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) \
- '*_SUITE_make' > $(EMAKEFILE)
- $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES)\
- >> $(EMAKEFILE)
-
-tests debug opt: make_emakefile
- erl $(ERL_MAKE_FLAGS) -make
-
-clean:
- rm -f $(EMAKEFILE)
- rm -f $(TARGET_FILES) $(GEN_FILES)
- rm -f core
-
-docs:
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
-
-release_tests_spec: make_emakefile
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)"
- $(INSTALL_DATA) test_server_test_lib.hrl test_server.spec test_server.cover "$(RELSYSDIR)"
- chmod -R u+w "$(RELSYSDIR)"
- @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
-
-release_docs_spec:
diff --git a/lib/test_server/test/test_server.cover b/lib/test_server/test/test_server.cover
deleted file mode 100644
index 052415377d..0000000000
--- a/lib/test_server/test/test_server.cover
+++ /dev/null
@@ -1 +0,0 @@
-{incl_app,test_server,details}.
diff --git a/lib/test_server/test/test_server.spec b/lib/test_server/test/test_server.spec
deleted file mode 100644
index a3b4d01d08..0000000000
--- a/lib/test_server/test/test_server.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites, "../test_server_test", all}.
diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk
deleted file mode 100644
index 3a3815c557..0000000000
--- a/lib/test_server/vsn.mk
+++ /dev/null
@@ -1 +0,0 @@
-TEST_SERVER_VSN = 3.9.1
diff --git a/lib/tools/Makefile b/lib/tools/Makefile
index 2699ffab51..fef33743c0 100644
--- a/lib/tools/Makefile
+++ b/lib/tools/Makefile
@@ -24,7 +24,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
# Macros
# ----------------------------------------------------
-SUB_DIRECTORIES = c_src src doc/src examples priv emacs
+SUB_DIRECTORIES = c_src src doc/src examples emacs
include vsn.mk
VSN = $(TOOLS_VSN)
diff --git a/lib/tools/c_src/Makefile.in b/lib/tools/c_src/Makefile.in
index 66bba229f6..e8bce149b1 100644
--- a/lib/tools/c_src/Makefile.in
+++ b/lib/tools/c_src/Makefile.in
@@ -97,11 +97,8 @@ DRIVERS=
ifneq ($(strip $(ETHR_LIB_NAME)),)
# Need ethread package for emem
-ifneq ($(findstring ose,$(TARGET)),ose)
-# Do not build on OSE
PROGS += $(BIN_DIR)/emem$(TYPEMARKER)@EXEEXT@
endif
-endif
EMEM_OBJ_DIR=$(OBJ_DIR)/emem
CREATE_DIRS += $(EMEM_OBJ_DIR)
@@ -152,12 +149,7 @@ ERTS_LIB = $(ERL_TOP/erts/lib_src/obj/$(TARGET)/$(TYPE)/MADE
_create_dirs := $(shell mkdir -p $(CREATE_DIRS))
-ifneq ($(findstring ose,$(TARGET)),ose)
all: $(PROGS) $(DRIVERS)
-else
-# Do not build dynamic files on OSE
-all:
-endif
$(ERTS_LIB):
$(make_verbose)cd $(ERL_TOP)/erts/lib_src && $(MAKE) $(TYPE)
diff --git a/lib/tools/doc/src/cover_chapter.xml b/lib/tools/doc/src/cover_chapter.xml
index 2f7f8d8083..c3f1570477 100644
--- a/lib/tools/doc/src/cover_chapter.xml
+++ b/lib/tools/doc/src/cover_chapter.xml
@@ -451,48 +451,5 @@ ok
<p>When Cover is stopped, all Cover compiled modules are unloaded.</p>
</section>
</section>
-
- <section>
- <title>Using the Web Based User Interface to Cover</title>
-
- <section>
- <title>Introduction</title>
- <p>To ease the use of Cover there is a web based user interface
- to Cover called WebCover. WebCover is designed to be started
- and used via WebTool. It is possible to Cover compile Erlang
- modules and to generate printable Cover and Call analyses via
- the web based user interface.</p>
- </section>
-
- <section>
- <title>Start the Web Based User Interface to Cover</title>
- <p>To start WebCover you can either start WebTool, point a
- browser to the start page of WebTool and start WebCover from
- there, or you can use the <c>start_webtool</c> script to start
- Webtool, WebCover and a browser. See WebTool documentation for
- further information.</p>
- <p>Currently WebCover is only compatible
- with Internet Explorer and Netscape Navigator 4.0 and higher.</p>
- </section>
-
- <section>
- <title>Navigating WebCover</title>
- <p>From the menu in the lefthand frame you can select the
- <c>Nodes</c>, <c>Compile</c>, <c>Import</c> or <c>Result</c>
- page.</p>
- <p>From the <c>Nodes</c> page you can add remote nodes to
- participate in the coverage analysis. Coverage data from all
- involved nodes will then be merged during analysis.</p>
- <p>From the <c>Compile</c> page you can Cover compile <c>.erl</c>
- or <c>.beam</c> files.</p>
- <p>From the <c>Import</c> page you can import coverage data from
- a previous analysis. Imported data will then be merged with
- the current coverage data. <em>Note</em> that it is only possible to
- import files with the extension <c>.coverdata</c>.</p>
- <p>From the <c>Result</c> page you can analyse, reset or export
- coverage data.</p>
- <p>Please follow the instructions on each page.</p>
- </section>
- </section>
</chapter>
diff --git a/lib/tools/emacs/erlang-skels-old.el b/lib/tools/emacs/erlang-skels-old.el
index c271cce3cb..d0b2bfd97f 100644
--- a/lib/tools/emacs/erlang-skels-old.el
+++ b/lib/tools/emacs/erlang-skels-old.el
@@ -816,7 +816,7 @@ Please see the function `tempo-define-template'.")
"%% Note: This directive should only be used in test suites." n
"-compile(export_all)." n n
- "-include_lib(\"test_server/include/test_server.hrl\")." n n
+ "-include_lib(\"common_test/include/ct.hrl\")." n n
(erlang-skel-separator 2)
"%% TEST SERVER CALLBACK FUNCTIONS" n
diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el
index 6880ec733c..ac37ff2ee5 100644
--- a/lib/tools/emacs/erlang-skels.el
+++ b/lib/tools/emacs/erlang-skels.el
@@ -1070,7 +1070,7 @@ Please see the function `tempo-define-template'.")
"%% Note: This directive should only be used in test suites." n
"-compile(export_all)." n n
- "-include_lib(\"test_server/include/test_server.hrl\")." n n
+ "-include_lib(\"common_test/include/ct.hrl\")." n n
(erlang-skel-separator-start 2)
"%% TEST SERVER CALLBACK FUNCTIONS" n
diff --git a/lib/gs/contribs/ebin/.gitignore b/lib/tools/priv/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/gs/contribs/ebin/.gitignore
+++ b/lib/tools/priv/.gitignore
diff --git a/lib/tools/priv/Makefile b/lib/tools/priv/Makefile
deleted file mode 100644
index aa4aaa2fc8..0000000000
--- a/lib/tools/priv/Makefile
+++ /dev/null
@@ -1,69 +0,0 @@
-# ``Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT 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 $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN = $(TOOLS_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-HTDOCS_FILES = index.html
-
-TOOL_FILES = cover.tool
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_COMPILE_FLAGS +=
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-debug opt:
-
-clean:
-
-docs:
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/priv"
- $(INSTALL_DATA) $(HTDOCS_FILES) "$(RELSYSDIR)/priv"
- $(INSTALL_DATA) $(TOOL_FILES) "$(RELSYSDIR)/priv"
-
-release_docs_spec:
-
-
-
diff --git a/lib/tools/priv/cover.tool b/lib/tools/priv/cover.tool
deleted file mode 100644
index 9e72f89ff4..0000000000
--- a/lib/tools/priv/cover.tool
+++ /dev/null
@@ -1,2 +0,0 @@
-{version,"1.2"}.
-[{config_func,{cover_web,configData,[]}}].
diff --git a/lib/tools/priv/index.html b/lib/tools/priv/index.html
deleted file mode 100644
index 6b60ef5d0a..0000000000
--- a/lib/tools/priv/index.html
+++ /dev/null
@@ -1,10 +0,0 @@
-<HTML>
-<HEAD>
-<TITLE>Erlang webb tools </TITLE>
-</HEAD>
-<FRAMESET COLS="250,*">
-<FRAME NAME="menu" SRC="/webcover/erl/cover_web/menu_frame">
-<FRAME NAME="main" SRC="/webcover/erl/cover_web/compile_frame">
-</FRAMESET>
-</HTML>
-
diff --git a/lib/tools/src/Makefile b/lib/tools/src/Makefile
index 9fcfb79628..7301ff856a 100644
--- a/lib/tools/src/Makefile
+++ b/lib/tools/src/Makefile
@@ -37,7 +37,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN)
MODULES= \
cover \
- cover_web \
eprof \
fprof \
cprof \
diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl
index d16ca7f406..3732b0fc85 100644
--- a/lib/tools/src/cover.erl
+++ b/lib/tools/src/cover.erl
@@ -20,9 +20,7 @@
-module(cover).
%%
-%% This module implements the Erlang coverage tool. The module named
-%% cover_web implements a user interface for the coverage tool to run
-%% under webtool.
+%% This module implements the Erlang coverage tool.
%%
%% ARCHITECTURE
%% The coverage tool consists of one process on each node involved in
diff --git a/lib/tools/src/cover_web.erl b/lib/tools/src/cover_web.erl
deleted file mode 100644
index ae8b3f25cf..0000000000
--- a/lib/tools/src/cover_web.erl
+++ /dev/null
@@ -1,1185 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
--module(cover_web).
--author('[email protected]').
--behaviour(gen_server).
-
-%%Export of configuration function
--export([configData/0]).
-%% External exports
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
- terminate/2, code_change/3]).
-
--export([start_link/0,start/0,stop/0]).
--export([menu_frame/2,nodes_frame/2,import_frame/2,
- compile_frame/2,result_frame/2]).
--export([list_dir/2,compile/2,add_node/2,remove_node/2,result/2,
- calls/2,coverage/2,import/2]).
-
--record(state,{dir}).
-
--include_lib("kernel/include/file.hrl").
-
-%% Timeouts
--define(DEFAULT_TIME,10000).
--define(MAX_COMPILE_TIME,60000).
--define(MAX_ANALYSE_TIME,30000).
-
-%% Colors
--define(INFO_BG_COLOR,"#C0C0EA").
-
-%%%----------------------------------------------------------------------
-%%% API - called from erlang shell
-%%%----------------------------------------------------------------------
-%% Start webtool and webcover from erlang shell
-start() ->
- webtool:start(),
- webtool:start_tools([],"app=webcover"),
- ok.
-
-%% Stop webtool and webcover from erlang shell
-stop() ->
- webtool:stop_tools([],"app=webcover"),
- webtool:stop().
-
-
-
-%%%----------------------------------------------------------------------
-%%% API - called from webtool
-%%%----------------------------------------------------------------------
-start_link() ->
- gen_server:start_link({local, webcover_server},cover_web, [], []).
-
-
-nodes_frame(Env,Input)->
- call({nodes_frame,Env,Input}).
-
-add_node(Env,Input)->
- call({add_node,Env,Input}).
-
-remove_node(Env,Input)->
- call({remove_node,Env,Input}).
-
-compile_frame(Env,Input)->
- call({compile_frame,Env,Input}).
-
-list_dir(Env,Input) ->
- call({list_dir,Env,Input}).
-
-compile(Env,Input)->
- call({compile,Env,Input},?MAX_COMPILE_TIME).
-
-result_frame(Env,Input)->
- call({result_frame,Env,Input}).
-
-result(Env,Input) ->
- call({result,Env,Input},?MAX_ANALYSE_TIME).
-
-calls(Env,Input) ->
- call({calls,Env,Input}).
-
-coverage(Env,Input) ->
- call({coverage,Env,Input}).
-
-import_frame(Env,Input)->
- call({import_frame,Env,Input}).
-
-import(Env,Input)->
- call({import,Env,Input}).
-
-menu_frame(Env,Input)->
- call({menu_frame,Env,Input}).
-
-call(Msg) ->
- call(Msg,?DEFAULT_TIME).
-call(Msg,Time) ->
- gen_server:call(webcover_server,Msg,Time).
-
-
-
-configData()->
- {webcover,[{web_data,{"WebCover","/webcover"}},
- {alias,{"/webcover",code:priv_dir(tools)}},
- {alias,{erl_alias,"/webcover/erl",[cover_web]}},
- {start,{child,{{local,webcover_server},
- {cover_web,start_link,[]},
- permanent,100,worker,[cover_web]}}}
- ]}.
-
-
-%%%----------------------------------------------------------------------
-%%% Callback functions from gen_server
-%%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Func: init/1
-%% Returns: {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%%----------------------------------------------------------------------
-init([]) ->
- cover:start(),
- CS = whereis(cover_server),
- link(CS),
- GL = spawn_link(fun group_leader_proc/0),
- group_leader(GL,CS),
-
- %% Must trap exists in order to have terminate/2 executed when
- %% crashing because of a linked process crash.
- process_flag(trap_exit,true),
- {ok,Cwd} = file:get_cwd(),
- {ok, #state{dir=Cwd}}.
-
-group_leader_proc() ->
- register(cover_group_leader_proc,self()),
- group_leader_loop([]).
-group_leader_loop(Warnings) ->
- receive
- {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} ->
- Msg = (catch io_lib:Func(Format,Args)),
- From ! {io_reply,ReplyAs,ok},
- case lists:member(Msg,Warnings) of
- true -> group_leader_loop(Warnings);
- false -> group_leader_loop([Msg|Warnings])
- end;
- {io_request,From,ReplyAs,{put_chars,_Encoding,io_lib,Func,[Format,Args]}} ->
- Msg = (catch io_lib:Func(Format,Args)),
- From ! {io_reply,ReplyAs,ok},
- case lists:member(Msg,Warnings) of
- true -> group_leader_loop(Warnings);
- false -> group_leader_loop([Msg|Warnings])
- end;
- IoReq when element(1,IoReq)=:= io_request ->
- group_leader() ! IoReq,
- group_leader_loop(Warnings);
- {From,get_warnings} ->
- Warnings1 =
- receive
- {io_request,From,ReplyAs,
- {put_chars,io_lib,Func,[Format,Args]}} ->
- Msg = (catch io_lib:Func(Format,Args)),
- From ! {io_reply,ReplyAs,ok},
- case lists:member(Msg,Warnings) of
- true -> Warnings;
- false -> [Msg|Warnings]
- end
- after 0 ->
- Warnings
- end,
- From ! {warnings,Warnings1},
- group_leader_loop([])
- end.
-
-%%----------------------------------------------------------------------
-%% Func: handle_call/3
-%% Returns: {reply, Reply, State} |
-%% {reply, Reply, State, Timeout} |
-%% {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, Reply, State} | (terminate/2 is called)
-%% {stop, Reason, State} (terminate/2 is called)
-%%----------------------------------------------------------------------
-handle_call({nodes_frame,_Env,_Input},_From,State)->
- {reply,nodes_frame1(),State};
-
-handle_call({add_node,_Env,Input},_From,State)->
- {reply,do_add_node(Input),State};
-
-handle_call({remove_node,_Env,Input},_From,State)->
- {reply,do_remove_node(Input),State};
-
-handle_call({compile_frame,_Env,_Input},_From,State)->
- {reply,compile_frame1(State#state.dir),State};
-
-handle_call({list_dir,_Env,Input},_From,State)->
- Dir = get_input_data(Input,"path"),
- case filelib:is_dir(Dir) of
- true ->
- {reply,compile_frame1(Dir),State#state{dir=Dir}};
- false ->
- Err = Dir ++ " is not a directory",
- {reply,compile_frame1(State#state.dir,Err),State}
- end;
-handle_call({compile,_Env,Input},_From,State)->
- {reply,do_compile(Input,State#state.dir),State};
-
-handle_call({result_frame,_Env,_Input},_From,State)->
- {reply,result_frame1(),State};
-
-handle_call({result,_Env,Input},_From,State)->
- {reply,handle_result(Input),State};
-
-handle_call({calls,_Env,Input},_From,State)->
- {reply,call_page(Input),State};
-
-handle_call({coverage,_Env,Input},_From,State)->
- {reply,coverage_page(Input),State};
-
-handle_call({import_frame,_Env,_Input},_From,State)->
- {ok,Cwd} = file:get_cwd(),
- {reply,import_frame1(Cwd),State};
-
-handle_call({import,_Env,Input},_From,State)->
- {reply,do_import(Input),State};
-
-handle_call({menu_frame,_Env,_Input},_From,State)->
- {reply,menu_frame1(),State};
-
-handle_call(_Request, _From, State) ->
- Reply = bad_request,
- {reply, Reply, State}.
-
-
-%%----------------------------------------------------------------------
-%% Func: handle_cast/2
-%% Returns: {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, State} (terminate/2 is called)
-%%----------------------------------------------------------------------
-handle_cast(_Msg, State) ->
- {noreply, State}.
-
-%%----------------------------------------------------------------------
-%% Func: handle_info/2
-%% Returns: {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, State} (terminate/2 is called)
-%%----------------------------------------------------------------------
-handle_info({'EXIT',_Pid,Reason}, State) ->
- {stop, Reason, State}.
-
-%%----------------------------------------------------------------------
-%% Func: terminate/2
-%% Purpose: Shutdown the server
-%% Returns: any (ignored by gen_server)
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- cover:stop(),
- ok.
-
-%%--------------------------------------------------------------------
-%% Func: code_change/3
-%% Purpose: Convert process state when code is changed
-%% Returns: {ok, NewState}
-%%--------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%%----------------------------------------------------------------------
-%%% Internal functions
-%%%----------------------------------------------------------------------
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% The functions that creates the whole pages by collecting all the %%
-%% neccessary data for each page. These functions are the public %%
-%% interface. %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%----------------------------------------------------------------------
-%% Returns the page to the left frame
-%%----------------------------------------------------------------------
-menu_frame1()->
- [header(),html_header(""),menu_body(),html_end()].
-
-%%----------------------------------------------------------------------
-%% Creates the page where the user can add and remove nodes
-%%----------------------------------------------------------------------
-
-nodes_frame1()->
- nodes_frame1([]).
-nodes_frame1(Err)->
- [header(),html_header("Add/remove nodes"),nodes_body(Err),html_end()].
-
-%%----------------------------------------------------------------------
-%% Creates the page where the user can cover compile modules
-%%----------------------------------------------------------------------
-
-compile_frame1(Dir)->
- compile_frame1(Dir,[]).
-compile_frame1(Dir,Err) ->
- [header(),html_header("Cover compile"),compile_body(Dir,Err),html_end()].
-
-%%----------------------------------------------------------------------
-%% Creates the page where the user can handle results
-%%----------------------------------------------------------------------
-
-result_frame1()->
- result_frame1([]).
-result_frame1(Err) ->
- [header(),html_header("Show cover results"),result_body(Err),html_end()].
-
-%%----------------------------------------------------------------------
-%%The beginning of the page that clear the cover information on a cover
-%%compiled module
-%%----------------------------------------------------------------------
-call_page(Input)->
- [header(),html_header("Code coverage"),call_result(Input),html_end()].
-
-coverage_page(Input)->
- [header(),html_header("Code coverage"),coverage_result(Input),html_end()].
-
-%%----------------------------------------------------------------------
-%% Creates the page where the user an import files
-%%----------------------------------------------------------------------
-import_frame1(Dir) ->
- import_frame1(Dir,"").
-import_frame1(Dir,Err) ->
- [header(),html_header("Import coverdata"),import_body(Dir,Err),html_end()].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% The functions that build the body of the menu frame %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-menu_body() ->
- Nodes = cover:which_nodes(),
- Modules = cover:modules(),
- Imported = cover:imported(),
- ["<A HREF=\"./nodes_frame\" TARGET=\"main\">Nodes</A><BR>\n",
- "<A HREF=\"./compile_frame\" TARGET=\"main\">Compile</A><BR>\n",
- "<A HREF=\"./import_frame\" TARGET=\"main\">Import</A><BR>\n",
- "<A HREF=\"./result_frame\" TARGET=\"main\">Result</A>\n",
- "<P><B>Nodes:</B>\n",
- "<UL>\n",
- lists:map(fun(N) -> "<LI>"++atom_to_list(N)++"</LI>\n" end,[node()|Nodes]),
- "</UL>\n",
- "<P><B>Compiled modules:</B>\n",
- "<UL>\n",
- lists:map(fun(M) -> "<LI>"++atom_to_list(M)++"</LI>\n" end,Modules),
- "</UL>\n",
- "<P><B>Imported files:</B>\n",
- "<UL>\n",
- "<FONT SIZE=-1>\n",
- lists:map(fun(F) ->
- Short = filename:basename(F),
- "<LI TITLE=\""++F++"\">"++Short++"</LI>\n" end,Imported),
- "</FONT>\n",
- "</UL>\n"].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% The functions that build the body of the nodes frame %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-nodes_body(Err) ->
- CN = cover:which_nodes(),
- Fun = fun(N) ->
- NStr = atom_to_list(N),
- ["<OPTION VALUE=",NStr,
- " onClick=\"node.value=selected_node.value\">",NStr,
- "</OPTION>\n"]
- end,
- AllNodes = lists:append(lists:map(Fun,nodes()--CN)),
- CoverNodes = lists:append(lists:map(Fun,CN)),
-
- [reload_menu_script(Err),
- "<H1 ALIGN=center>Nodes</H1>\n",
- "<TABLE BORDER=0 WIDTH=600 ALIGN=center>\n",
- "<TR><TD BGCOLOR=",?INFO_BG_COLOR," COLSPAN=2>\n",
- "<P>You can run cover over several nodes simultaneously. Coverage data\n",
- "from all involved nodes will be merged during analysis.\n",
- "<P>Select or enter node names to add or remove here.\n",
- "</TD></TR>\n",
- "<TR><TD COLSPAN=2><BR><BR></TD></TR>\n",
- "<FORM ACTION=\"./add_node\" NAME=add_node>\n",
- "<TR><TD VALIGN=top>Add node:</TD>\n",
- "<TD><INPUT TYPE=text NAME=\"node\" SIZE=40 >",
- "<INPUT TYPE=submit\n",
- " onClick=\"if(!node.value){node.value=selected_node.value};\" VALUE=Add>"
- "<BR><SELECT NAME=selected_node TITLE=\"Select node\">\n",
- AllNodes ++
- "</SELECT>\n",
- "</TD></TR>\n"
- "</FORM>\n",
- "<TR><TD COLSPAN=2><BR><BR></TD></TR>\n",
- "<FORM ACTION=\"./remove_node\" NAME=remove_node>\n",
- "<TR><TD>Remove node:</TD>\n",
- "<TD><SELECT NAME=node TITLE=\"Select node\">\n",
- CoverNodes ++
- "</SELECT>\n",
- "<INPUT TYPE=submit VALUE=Remove>"
- "</TD></TR>\n",
- "</FORM>",
- "</TABLE>"].
-
-
-do_add_node(Input) ->
- NodeStr = get_input_data(Input, "node"),
- Node = list_to_atom(NodeStr),
- case net_adm:ping(Node) of
- pong ->
- cover:start(Node),
- nodes_frame1();
- pang ->
- nodes_frame1("Node \\\'" ++ NodeStr ++ "\\\' is not alive")
- end.
-
-do_remove_node(Input) ->
- Node = list_to_atom(get_input_data(Input, "node")),
- cover:stop(Node),
- nodes_frame1().
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% %
-% The functions that is used when the user wants to compile something %
-% %
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-compile_body(Dir,Err) ->
- Erls = filelib:wildcard(filename:join(Dir,"*.erl")),
- Beams = filelib:wildcard(filename:join(Dir,"*.beam")),
-
- [reload_menu_script(Err),
- "<H1 ALIGN=center>Compile</H1>\n",
- "<TABLE WIDTH=600 ALIGN=center BORDER=0>\n",
- "<TR><TD COLSPAN=3 BGCOLOR=",?INFO_BG_COLOR,">\n",
- "Each module which shall be part of the cover analysis must be prepared\n",
- "or 'cover compiled'. On this page you can select .erl files and/or\n",
- ".beam files to include in the analysis. If you select a .erl file it\n",
- "will first be compiled with the Erlang compiler and then prepared for\n",
- "coverage analysis. If you select a .beam file it will be prepared for\n",
- "coverage analysis directly.\n",
- "</TD></TR>\n",
- "<FORM ACTION=\"./list_dir\" NAME=list_dir>\n",
- "<TR><TD WIDTH=30% BGCOLOR=",?INFO_BG_COLOR," ROWSPAN=2>\n",
- "To list a different directory, enter the directory name here.\n",
- "</TD>\n",
- "<TH COLSPAN=2><BR>List directory:<BR></TH>\n",
- "</TR>\n",
- "<TR><TD ALIGN=center COLSPAN=2>\n",
- "<INPUT TYPE=text NAME=\"path\" SIZE=40 VALUE=",Dir,">",
- "<INPUT TYPE=submit VALUE=Ok>",
- "<BR><BR></TD></TR>\n",
- "</FORM>\n",
- "<FORM ACTION=\"./compile\" NAME=compile_selection>\n",
- "<TR><TD BGCOLOR=",?INFO_BG_COLOR," ROWSPAN=2>\n",
- "<P>Select one or more .erl or .beam files to prepare for coverage\n"
- "analysis, and click the \"Compile\" button.\n",
- "<P>To reload the original file after coverage analysis is complete,\n"
- "select one or more files and click the \"Uncompile\" button, or\n",
- "simply click the \"Uncompile all\" button to reload all originals.\n"
- "</TD>\n",
- "<TH>.erl files</TH><TH>.beam files</TH></TR>\n",
- "<TR><TD ALIGN=center VALIGN=top>\n",
- "<SELECT NAME=erl TITLE=\"Select .erl files to compile\" MULTIPLE=true",
- " SIZE=15>\n",
- list_modules(Erls) ++
- "</SELECT></TD>\n",
- "<TD ALIGN=center VALIGN=top>\n",
- "<SELECT NAME=beam TITLE=\"Select .beam files to compile\"MULTIPLE=true",
- " SIZE=15>\n",
- list_modules(Beams) ++
- "</SELECT></TD></TR>\n"
- "<TR><TD BGCOLOR=",?INFO_BG_COLOR," ROWSPAN=2>\n",
- "Compile options are only needed for .erl files. The options must be\n"
- "given e.g. like this: \n"
- "<FONT SIZE=-1>[{i,\"/my/path/include\"},{i,\"/other/path/\"}]</FONT>\n"
- "</TD>\n",
- "<TH COLSPAN=2><BR>Compile options:<BR></TH>\n",
- "</TR>\n",
- "<TR><TD COLSPAN=2 ALIGN=center>\n",
- "<INPUT TYPE=text NAME=\"options\" SIZE=40>\n",
- "<INPUT TYPE=hidden NAME=\"action\"></TD></TR>\n",
- "<TR><TD></TD><TD ALIGN=center COLSPAN=2>\n",
- "<INPUT TYPE=submit onClick=\"action.value=\'compile\';\"VALUE=Compile>",
- "<INPUT TYPE=submit onClick=\"action.value=\'uncompile\';\" ",
- "VALUE=Uncompile>",
- "<INPUT TYPE=submit onClick=\"action.value=\'uncompile_all\';\" ",
- "VALUE=\"Uncompile all\">",
- "<BR><INPUT TYPE=reset VALUE=\"Reset form\"></TD></TR>\n",
- "</FORM>\n",
- "</TABLE>\n"].
-
-list_modules([File|Files]) ->
- Mod = filename:basename(File),
- ["<OPTION VALUE=",File," onDblClick=\"action.value=\'compile\';submit();\">",
- Mod,"</OPTION>\n" | list_modules(Files)];
-list_modules([]) ->
- [].
-
-do_compile(Input,Dir) ->
- {Erls,Beams,Opts,Action} = get_compile_input(parse(Input),[],[]),
- Errs =
- case Action of
- "compile" ->
- do_compile(Erls,Beams,Opts,[]);
- "uncompile" ->
- do_uncompile(Erls++Beams);
- "uncompile_all" ->
- do_uncompile(cover:modules())
- end,
- compile_frame1(Dir,Errs).
-
-get_compile_input([{"erl",File}|Input],Erl,Beam) ->
- get_compile_input(Input,[File|Erl],Beam);
-get_compile_input([{"beam",File}|Input],Erl,Beam) ->
- get_compile_input(Input,Erl,[File|Beam]);
-get_compile_input([{"options",Opts0},{"action",Action}],Erl,Beam) ->
- Opts = parse_options(Opts0),
- {Erl,Beam,Opts,Action}.
-
-do_compile([Erl|Erls],Beams,Opts,Errs) ->
- case cover:compile_module(Erl,Opts) of
- {ok,_} ->
- do_compile(Erls,Beams,Opts,Errs);
- {error,File} ->
- do_compile(Erls,Beams,Opts,["\\n"++File|Errs])
- end;
-do_compile([],[Beam|Beams],Opts,Errs) ->
- case cover:compile_beam(Beam) of
- {ok,_} ->
- do_compile([],Beams,Opts,Errs);
- {error,{no_abstract_code,File}} ->
- do_compile([],Beams,Opts,["\\n"++File++" (no_abstract_code)"|Errs])
- end;
-do_compile([],[],_,[]) ->
- [];
-do_compile([],[],_,Errs) ->
- "Compilation failed for the following files:" ++ Errs.
-
-parse_options(Options)->
- case erl_scan:string(Options ++".") of
- {ok,Tokens,_Line} ->
- case erl_parse:parse_exprs(Tokens) of
- {ok,X}->
- case lists:map(fun erl_parse:normalise/1, X) of
- [List] when is_list(List) -> List;
- List -> List
- end;
- _ ->
- []
- end;
- _ ->
- []
- end.
-
-
-do_uncompile(Files) ->
- lists:foreach(
- fun(File) ->
- Module =
- if is_atom(File) ->
- File;
- true ->
- ModStr = filename:basename(filename:rootname(File)),
- list_to_atom(ModStr)
- end,
- case code:which(Module) of
- cover_compiled ->
- code:purge(Module),
- case code:load_file(Module) of
- {module, Module} ->
- ok;
- {error, _Reason2} ->
- code:delete(Module)
- end;
- _ ->
- ok
- end
- end,
- Files),
- [].
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% %
-% The functions that builds the body of the page for coverage analysis%
-% %
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-result_body(Err) ->
- [reload_menu_script(Err),
- "<H1 ALIGN=center>Result</H1>\n",
- "<TABLE BORDER=0 WIDTH=600 ALIGN=center>\n",
- "<TR><TD BGCOLOR=",?INFO_BG_COLOR,">\n",
- "<P>After executing all your tests you can view the result of the\n",
- "coverage analysis here. For each module you can\n",
- "<DL>\n",
- "<DT><B>Analyse to file</B></DT>\n",
- "<DD>The source code of the module is shown with the number of calls\n",
- "to each line stated in the left margin. Lines which are never called\n",
- "are colored red.</DD>\n",
- "<DT><B>Analyse coverage</B></DT>\n",
- "<DD>Show the number of covered and uncovered lines in the module.</DD>\n",
- "<DT><B>Analyse calls</B></DT>\n",
- "<DD>Show the number of calls in the module.</DD>\n",
- "<DT><B>Reset module</B></DT>\n",
- "<DD>Delete all coverage data for the module.</DD>\n",
- "<DT><B>Export module</B></DT>\n",
- "<DD>Write all coverage data for the module to a file. The data can\n",
- "later be imported from the \"Import\" page.</DD>\n",
- "</DL>\n",
- "<P>You can also reset or export data for all modules with the\n",
- "<B>Reset all</B> and <B>Export all</B> actions respectively. For these\n",
- "two actions there is no need to select a module.\n",
- "<P>Select module and action from the drop down menus below, and click\n",
- "the \"Execute\" button.\n",
- "</TD></TR>\n",
- "<TR><TD><BR><BR>\n",
- result_selections(),
- "</TD></TR></TABLE>"].
-
-result_selections() ->
- ModList = filter_modlist(cover:modules()++cover:imported_modules(),[]),
-
- ["<FORM ACTION=\"./result\" NAME=result_selection>\n",
- "<TABLE WIDTH=\"300\" BORDER=0 ALIGN=center>\n",
- "<TR><TD ALIGN=left>\n",
- "Module:\n",
- "<BR><SELECT NAME=module TITLE=\"Select module\">\n",
- ModList ++
- "</SELECT>\n",
- "</TD>\n",
- "<TD ALIGN=left>\n",
- "Action:\n",
- "<BR><SELECT NAME=action TITLE=\"Select action\">\n",
- "<OPTION VALUE=\"analyse_to_file\">Analyse to file</OPTION>\n"
- "<OPTION VALUE=\"coverage\">Analyse coverage</OPTION>\n"
- "<OPTION VALUE=\"calls\">Analyse calls</OPTION>\n"
- "<OPTION VALUE=\"reset\">Reset module</OPTION>\n"
- "<OPTION VALUE=\"reset_all\">Reset all</OPTION>\n"
- "<OPTION VALUE=\"export\">Export module</OPTION>\n"
- "<OPTION VALUE=\"export_all\">Export all</OPTION>\n"
- "</SELECT>\n",
- "</TD>\n",
- "<TD ALIGN=center VALIGN=bottom><INPUT TYPE=submit VALUE=Execute>\n"
- "</TD></TR>\n"
- "</TABLE>\n",
- "</FORM>\n"].
-
-filter_modlist([M|Ms],Already) ->
- case lists:member(M,Already) of
- true ->
- filter_modlist(Ms,Already);
- false ->
- MStr = atom_to_list(M),
- ["<OPTION VALUE=",MStr,">",MStr,"</OPTION>\n" |
- filter_modlist(Ms,[M|Already])]
- end;
-filter_modlist([],_Already) ->
- [].
-
-
-
-handle_result(Input) ->
- case parse(Input) of
- [{"module",M},{"action",A}] ->
- case A of
- "analyse_to_file" ->
- case cover:analyse_to_file(list_to_atom(M),[html]) of
- {ok,File} ->
- case file:read_file(File) of
- {ok,HTML}->
- file:delete(File),
- [header(),
- reload_menu_script(""),
- binary_to_list(HTML)];
- _ ->
- result_frame1("Can not read file" ++ File)
- end;
- {error,no_source_code_found} ->
- result_frame1("No source code found for \\\'" ++
- M ++ "\\\'")
- end;
- "calls" ->
- call_page(Input);
- "coverage" ->
- coverage_page(Input);
- "reset" ->
- cover:reset(list_to_atom(M)),
- result_frame1("Coverage data for \\\'" ++ M ++
- "\\\' is now reset");
- "reset_all" ->
- cover:reset(),
- result_frame1("All coverage data is now reset");
- "export" ->
- ExportFile = generate_filename(M),
- cover:export(ExportFile,list_to_atom(M)),
- result_frame1("Coverage data for \\\'" ++ M ++
- "\\\' is now exported to file \\\"" ++
- ExportFile ++ "\\\"");
- "export_all" ->
- ExportFile = generate_filename("COVER"),
- cover:export(ExportFile),
- result_frame1(
- "All coverage data is now exported to file \\\"" ++
- ExportFile ++ "\\\"")
- end;
- [{"action",_A}] ->
- result_frame1("No module is selected")
- end.
-
-generate_filename(Prefix) ->
- {ok,Cwd} = file:get_cwd(),
- filename:join(Cwd,Prefix ++ "_" ++ ts() ++ ".coverdata").
-
-ts() ->
- {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(erlang:timestamp()),
- io_lib:format("~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w",
- [Y,M,D,H,Min,S]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% %
-% The functions that builds the body of the page that shows the calls %
-% %
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-call_result(Input)->
- Mod = list_to_atom(get_input_data(Input, "module")),
- case cover:analyse(Mod,calls) of
- {error,_}->
- error_body();
- {ok,_} ->
- call_result2(Mod,Input)
- end.
-
-call_result2(Mod,Input)->
- Result =
- case get_input_data(Input,"what") of
- "mod" ->
- call_result(mod,Mod);
- "func" ->
- call_result(func,Mod);
- "clause" ->
- call_result(clause,Mod);
- _->
- call_result(all,Mod)
- end,
- result_choice("calls",Mod) ++ Result.
-
-result_choice(Level,Mod)->
- ModStr=atom_to_list(Mod),
- [reload_menu_script(""),
- "<TABLE WIDTH=100%><TR>\n",
- "<TD><A HREF=./",Level,"?module=",ModStr,"&what=all>All Data</A></TD>\n",
- "<TD><A HREF=./",Level,"?module=",ModStr,"&what=mod>Module</A></TD>\n",
- "<TD><A HREF=./",Level,"?module=",ModStr,"&what=func>Function</A></TD>\n",
- "<TD><A HREF=./",Level,"?module=",ModStr,"&what=clause>Clause</A></TD>\n",
- "</TR></TABLE><BR>\n"].
-
-call_result(Mode,Module)->
- Content =
- case Mode of
- mod->
- format_cover_call(cover:analyse(Module,calls,module),mod);
- func->
- format_cover_call(cover:analyse(Module,calls,function),func);
- clause->
- format_cover_call(cover:analyse(Module,calls,clause),clause);
- _->
- format_cover_call(cover:analyse(Module,calls,module),mod) ++
- format_cover_call(cover:analyse(Module,calls,function),func)++
- format_cover_call(cover:analyse(Module,calls,clause),clause)
- end,
- getModDate(Module,date())++"<BR>"++
- "<TABLE WIDTH=\"100%\" BORDER=1>"
- ++ Content ++"</TABLE>".
-
-
-format_cover_call({error,_},_)->
- ["<TR><TD>\n",
- "<BR><BR><BR><BR>\n",
- "<FONT SIZE=5>The selected module is not Cover Compiled</FONT>\n",
- "<BR>\n",
- "</TD></TR>\n"];
-
-format_cover_call({ok,{Mod,Calls}},mod)->
- ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=5><B>Module calls</B></TD></TR>\n",
- "<TR><TD COLSPAN=4><I>Module</I></TD>",
- "<TD ALIGN=\"right\"><I>Number of calls</I></TD></TR>\n",
- "<TR><TD COLSPAN=4>" ++ atom_to_list(Mod) ++"</TD>"
- "<TD ALIGN=\"right\">" ++ integer_to_list(Calls)++"</TD></TR>\n"];
-
-format_cover_call({ok,Calls},func)->
- ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=5><B>Function calls</B></TD></TR>\n",
- "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>",
- "<TD COLSPAN=2 ALIGN=\"right\"><I>Arity</I></TD>",
- "<TD ALIGN=\"right\"><I>Number of calls </I></TD></TR>\n",
- lists:append(
- lists:map(
- fun({{Mod,Func,Arity},Nr_of_calls})->
- ["<TR><TD WIDTH=\"20%\">"++ atom_to_list(Mod)++"</TD>\n",
- "<TD WIDTH=\"20%\" >" ++ atom_to_list(Func) ++" </TD>\n",
- "<TD COLSPAN=2 WIDTH=\"40%\" ALIGN=\"right\">",
- integer_to_list(Arity),
- "</TD>\n",
- "<TD WIDTH=\"20%\" ALIGN=\"right\">",
- integer_to_list(Nr_of_calls),
- "</TD></TR>\n"]
- end,
- Calls))];
-
-format_cover_call({ok,Calls},clause)->
- ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=5><B>Clause calls</B></TD></TR>\n",
- "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>",
- "<TD ALIGN=\"right\"><I>Arity</I></TD>",
- "<TD ALIGN=\"right\"><I>Ordinal</I></TD>",
- "<TD ALIGN=\"right\"><I>Number of calls</I></TD></TR>\n",
- lists:append(
- lists:map(
- fun({{Mod,Func,Arity,Ord},Nr_of_calls})->
- ["<TR><TD WIDTH=\"20%\" >", atom_to_list(Mod), "</TD>\n",
- "<TD WIDTH=\"20%\" >", atom_to_list(Func), "</TD>\n",
- "<TD WIDTH=\"20%\" ALIGN=\"right\">",
- integer_to_list(Arity),
- "</TD>\n",
- "<TD WIDTH=\"20%\" ALIGN=\"right\">",
- integer_to_list(Ord),
- "</TD>\n",
- "<TD WIDTH=\"20%\" ALIGN=\"right\">",
- integer_to_list(Nr_of_calls),
- "</TD></TR>\n"]
- end,
- Calls))].
-
-
-error_body()->
- ["<TABLE WIDTH=\"100%\" BORDER=1>\n",
- "<TR ALIGN=\"center\">\n",
- "<TD>\n",
- "<BR><BR><BR><BR><BR><BR>\n",
- "<FONT SIZE=5>The selected module is not Cover Compiled</FONT>\n",
- "<BR>\n",
- "</TD>\n",
- "</TR>\n",
- "</TABLE>\n"].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% %
-% The functions that builds the body of the page that shows coverage %
-% %
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-coverage_result(Input)->
- Mod = list_to_atom(get_input_data(Input, "module")),
- case cover:analyse(Mod,coverage) of
- {error,_}->
- error_body();
- {ok,_} ->
- coverage_result2(Mod,Input)
- end.
-
-coverage_result2(Mod,Input)->
- Result =
- case get_input_data(Input,"what") of
- "mod" ->
- coverage_result(mod,Mod);
- "func" ->
- coverage_result(func,Mod);
- "clause" ->
- coverage_result(clause,Mod);
- _->
- coverage_result(all,Mod)
- end,
- result_choice("coverage",Mod) ++ Result.
-
-coverage_result(Mode,Module)->
- Content =
- case Mode of
- mod->
- format_cover_coverage(cover:analyse(Module,coverage,module),
- mod);
- func->
- format_cover_coverage(cover:analyse(Module,coverage,function),
- func);
- clause->
- format_cover_coverage(cover:analyse(Module,coverage,clause),
- clause);
- _->
- format_cover_coverage(cover:analyse(Module,coverage,module),
- mod) ++
- format_cover_coverage(cover:analyse(Module,coverage,function),
- func)++
- format_cover_coverage(cover:analyse(Module,coverage,clause),
- clause)
- end,
- getModDate(Module,date())++"<BR>"++
- "<TABLE WIDTH=\"100%\" BORDER=1>"
- ++ Content ++"</TABLE>".
-
-getModDate(Module,{Year,Mon,Day})->
- "<TABLE>
- <TR>
- <TD>Module:</TD>
- <TD>" ++ atom_to_list(Module) ++ "</TD>
- </TR>
- <TR>
- <TD>Date:</TD>
- <TD>" ++ integer_to_list(Day) ++ "/" ++
- integer_to_list(Mon) ++"&nbsp;-&nbsp;"++
- integer_to_list(Year) ++
- "</TD>
- </TR>
- </TABLE>".
-
-
-format_cover_coverage({error,_},_)->
- "<TR><TD>
- <BR><BR><BR><BR>
- <FONT SIZE=5>The selected module is not Cover Compiled</FONT>
- <BR>
- </TD></TR>";
-
-
-format_cover_coverage({ok,{Mod,{Cov,Not_cov}}},mod)->
- ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6><B>Module coverage</B></TD></TR>\n",
- "<TR><TD COLSPAN=4><I>Module</I></TD>\n",
- "<TD ALIGN=\"right\"><I>Covered</I></TD>\n"
- "<TD ALIGN=\"RIGHT\" NOWRAP=\"true\"><I>Not Covered</I></TD>\n",
- "</TR>\n",
- "<TR><TD COLSPAN=4>", atom_to_list(Mod), "</TD>\n"
- "<TD ALIGN=\"right\">", integer_to_list(Cov), "</TD>\n"
- "<TD ALIGN=\"right\" >", integer_to_list(Not_cov), "</TD></TR>\n"];
-
-format_cover_coverage({ok,Cov_res},func)->
- ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6><B>Function coverage</B></TD>\n",
- "</TR>\n",
- "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>",
- "<TD ALIGN=\"right\"><I>Arity</I></TD>",
- "<TD COLSPAN=2 ALIGN=\"right\"><I>Covered</I></TD>",
- "<TD ALIGN=\"right\" STYLE=\"white-space:nowrap\"><I>Not Covered</I></TD>",
- "</TR>\n",
- lists:append(
- lists:map(
- fun({{Mod,Func,Arity},{Cov,Not_cov}})->
- ["<TR><TD WIDTH=\"20%\" >"++ atom_to_list(Mod) ++" </TD>\n",
- "<TD WIDTH=\"20%\" >" ++ atom_to_list(Func) ++"</TD>\n",
- "<TD WIDTH=\"40%\" ALIGN=\"right\">",
- integer_to_list(Arity),
- "</TD>\n",
- "<TD WIDTH=\"40%\" ALIGN=\"right\" COLSPAN=2>",
- integer_to_list(Cov),
- "</TD>\n"
- "<TD WIDTH=\"20%\" ALIGN=\"right\">",
- integer_to_list(Not_cov),
- "</TD></TR>\n"]
- end,
- Cov_res))];
-
-format_cover_coverage({ok,Cov_res},clause)->
- ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6><B>Clause coverage</B></TD></TR>\n",
- "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>\n",
- "<TD ALIGN=\"right\"><I>Arity</I></TD>\n",
- "<TD ALIGN=\"right\"><I>Ordinal<I></TD>\n",
- "<TD ALIGN=\"right\">Covered</TD>\n",
- "<TD ALIGN=\"right\" STYLE=\"white-space:nowrap\">Not Covered</TD></TR>\n",
- lists:append(
- lists:map(
- fun({{Mod,Func,Arity,Ord},{Cov,Not_cov}})->
- ["<TR><TD WIDTH=\"20%\" >"++ atom_to_list(Mod) ++"</TD>\n",
- "<TD WIDTH=\"20%\" >" ++ atom_to_list(Func) ++" </TD>\n",
- "<TD WIDTH=\"20%\" ALIGN=\"right\">",
- integer_to_list(Arity),
- "</TD>\n"
- "<TD WIDTH=\"20%\" ALIGN=\"right\">",
- integer_to_list(Ord),
- "</TD>\n"
- "<TD WIDTH=\"20%\" ALIGN=\"right\">",
- integer_to_list(Cov),
- "</TD>\n"
- "<TD WIDTH=\"20%\" ALIGN=\"right\">",
- integer_to_list(Not_cov),
- "</TD></TR>\n"]
- end,
- Cov_res))].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% %
-% The functions that builds the body of the import page %
-% %
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-import_body(Dir,Err) ->
- [reload_menu_script(Err),
- "<H1 ALIGN=center>Import</H1>\n",
- "<TABLE BORDER=0 WIDTH=600 ALIGN=center>\n",
- "<TR><TD BGCOLOR=",?INFO_BG_COLOR,">\n",
- "<P>You can import coverage data from a previous analysis. If you do so\n",
- "the imported data will be merged with the current coverage data.\n",
- "<P>You can export data from the current analysis from the \"Result\"\n",
- "page.\n",
- "<P>Select the file to import here.\n",
- "</TD></TR>\n",
- "<TR><TD ALIGN=center><BR><BR>\n",
- "<FORM NAME=change_import_dir METHOD=post ACTION=\"./import\">\n",
- "<B>Change directory:</B><BR>\n",
- "<INPUT TYPE=text NAME=\"file\" SIZE=30 VALUE=",Dir,">",
- "<INPUT TYPE=hidden NAME=dir VALUE=",Dir,">\n",
- "<INPUT TYPE=submit VALUE=Ok><BR>\n",
- "</FORM>\n",
- browse_import(Dir),
- "</TABLE>"].
-
-browse_import(Dir) ->
- {ok,List} = file:list_dir(Dir),
- Sorted = lists:reverse(lists:sort(List)),
- {Dirs,Files} = filter_files(Dir,Sorted,[],[]),
- ["<FORM NAME=browse_import METHOD=post ACTION=\"./import\">\n"
- "<SELECT NAME=file TITLE=\"Select import file\" SIZE=10>\n",
- "<OPTION VALUE=\"..\" onDblClick=submit()>../</OPTION>\n",
- Dirs,
- Files,
- "</SELECT>\n",
- "<INPUT TYPE=hidden NAME=dir VALUE=",Dir,">\n",
- "<BR><INPUT TYPE=submit VALUE=Ok>\n"
- "</FORM>\n"].
-
-filter_files(Dir,[File|Files],Ds,Fs) ->
- case filename:extension(File) of
- ".coverdata" ->
- Fs1 = ["<OPTION VALUE=",File," onDblClick=submit()>",
- File,"</OPTION>\n" | Fs],
- filter_files(Dir,Files,Ds,Fs1);
- _ ->
- FullName = filename:join(Dir,File),
- case filelib:is_dir(FullName) of
- true ->
- Ds1 = ["<OPTION VALUE=",File," onDblClick=submit()>",
- File,"/</OPTION>\n" | Ds],
- filter_files(Dir,Files,Ds1,Fs);
- false ->
- filter_files(Dir,Files,Ds,Fs)
- end
- end;
-filter_files(_Dir,[],Ds,Fs) ->
- {Ds,Fs}.
-
-
-
-
-do_import(Input) ->
- case parse(Input) of
- [{"file",File0},{"dir",Dir}] ->
- File = filename:join(Dir,File0),
- case filelib:is_dir(File) of
- true ->
- import_frame1(File);
- false ->
- case filelib:is_file(File) of
- true ->
- case cover:import(File) of
- ok ->
- import_frame1(Dir);
- {error,{cant_open_file,ExportFile,_Reason}} ->
- import_frame1(Dir,
- "Error importing file\\n\\\""
- ++ ExportFile ++ "\\\"")
- end;
- false ->
- import_frame1(Dir,
- "Error importing file\\n\\\"" ++
- File ++ "\\\"")
- end
- end;
- [{"dir",Dir}] ->
- import_frame1(Dir,"No file is selected")
- end.
-
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% %
-% Different private helper functions %
-% %
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%Create the Header for the page If we now the mimetype use that type %%
-%%otherwise use text %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-header() ->
- header("text/html").
-header(MimeType) ->
- "Pragma:no-cache\r\n" ++
- "Content-type: " ++ MimeType ++ "\r\n\r\n".
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%Create the Htmlheader set the title of the page %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-html_header(Title) ->
- "<HTML>\n" ++
- "<HEAD>\n" ++
- "<TITLE>" ++ Title ++ "</TITLE>\n" ++
- "</HEAD>\n"
- "<BODY BGCOLOR=\"#FFFFFF\">\n".
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Close the body- and Html tags %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-html_end()->
- "</BODY></HTML>".
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% A script which reloads the menu frame and possibly pops up an alert%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-reload_menu_script(Err) ->
- ["<SCRIPT>\n",
- "function reloadMenu()\n",
- " {\n",
- " parent.menu.document.location.href=\"./menu_frame\";\n",
- case Err of
- "" -> "";
- _ -> " alert(\""++Err++"\");\n"
- end,
- case get_warnings() of
- [] ->
- "";
- Warnings ->
- " alert(\""++fix_newline(lists:flatten(Warnings))++"\");\n"
- end,
- " }\n",
- "</SCRIPT>\n",
- "<BODY onLoad=reloadMenu() BGCOLOR=\"#FFFFFF\">"].
-
-fix_newline([$\n|Rest]) ->
- [$\\,$n|fix_newline(Rest)];
-fix_newline([$"|Rest]) ->
- [$\\,$"|fix_newline(Rest)];
-fix_newline([Char|Rest]) ->
- [Char|fix_newline(Rest)];
-fix_newline([]) ->
- [].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% Control the input data and return the intresting values or error %
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_input_data(Input,Key)->
- case lists:keysearch(Key,1,parse(Input)) of
- {value,{Key,Value}} ->
- Value;
- false ->
- undefined
- end.
-
-parse(Input) ->
- httpd:parse_query(Input).
-
-
-get_warnings() ->
- cover_group_leader_proc ! {self(), get_warnings},
- receive {warnings,Warnings} ->
- Warnings
- end.
diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl
index 3a3cebf3ed..d552d5b46e 100644
--- a/lib/tools/src/lcnt.erl
+++ b/lib/tools/src/lcnt.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -94,12 +94,12 @@
-record(stats, {
file :: atom(),
- line :: non_neg_integer(),
+ line :: non_neg_integer() | 'undefined',
tries :: non_neg_integer(),
colls :: non_neg_integer(),
time :: non_neg_integer(), % us
nt :: non_neg_integer(), % #timings collected
- hist :: tuple() % histogram
+ hist :: tuple() | 'undefined' % histogram
}).
-record(lock, {
@@ -757,7 +757,7 @@ list2lock([F|Fs], Ls) ->
stats2stats([]) -> [];
stats2stats([Stat|Stats]) ->
- Sz = tuple_size(#stats{}),
+ Sz = record_info(size, stats),
[stat2stat(Stat,Sz)|stats2stats(Stats)].
stat2stat(Stat,Sz) when tuple_size(Stat) =:= Sz -> Stat;
diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl
index 5d5a1ef2bd..26378f28a0 100644
--- a/lib/tools/src/make.erl
+++ b/lib/tools/src/make.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% 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.
@@ -299,10 +299,11 @@ check_includes(File, IncludePath, ObjMTime) ->
end.
check_includes2(Epp, File, ObjMTime) ->
+ A1 = erl_anno:new(1),
case epp:parse_erl_form(Epp) of
- {ok, {attribute, 1, file, {File, 1}}} ->
+ {ok, {attribute, A1, file, {File, A1}}} ->
check_includes2(Epp, File, ObjMTime);
- {ok, {attribute, 1, file, {IncFile, 1}}} ->
+ {ok, {attribute, A1, file, {IncFile, A1}}} ->
case file:read_file_info(IncFile) of
{ok, #file_info{mtime=MTime}} when MTime>ObjMTime ->
epp:close(Epp),
diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src
index 978b54719c..a00969eabe 100644
--- a/lib/tools/src/tools.app.src
+++ b/lib/tools/src/tools.app.src
@@ -21,7 +21,6 @@
[{description, "DEVTOOLS CXC 138 16"},
{vsn, "%VSN%"},
{modules, [cover,
- cover_web,
eprof,
fprof,
instrument,
@@ -36,12 +35,12 @@
xref_utils
]
},
- {registered,[webcover_server]},
+ {registered, []},
{applications, [kernel, stdlib]},
{env, [{file_util_search_methods,[{"", ""}, {"ebin", "esrc"}, {"ebin", "src"}]}
]
},
- {runtime_dependencies, ["webtool-0.8.10","stdlib-2.5","runtime_tools-1.8.14",
+ {runtime_dependencies, ["stdlib-2.5","runtime_tools-1.8.14",
"kernel-3.0","inets-5.10","erts-7.0",
"compiler-5.0"]}
]
diff --git a/lib/tools/test/Makefile b/lib/tools/test/Makefile
index 49b86628b7..8768413dc1 100644
--- a/lib/tools/test/Makefile
+++ b/lib/tools/test/Makefile
@@ -53,8 +53,7 @@ RELSYSDIR = $(RELEASE_PATH)/tools_test
# FLAGS
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \
- -I$(ERL_TOP)/lib/percept/include
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/percept/include
EBIN = .
diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl
index 71570a55fa..b9a9cd5be4 100644
--- a/lib/tools/test/cover_SUITE.erl
+++ b/lib/tools/test/cover_SUITE.erl
@@ -21,7 +21,7 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/tools/test/cover_SUITE_data/d.erl b/lib/tools/test/cover_SUITE_data/d.erl
index 696e27e49b..b1d8ebd62e 100644
--- a/lib/tools/test/cover_SUITE_data/d.erl
+++ b/lib/tools/test/cover_SUITE_data/d.erl
@@ -6,7 +6,7 @@
size/0]).
-export([init/0]). % spawn
--record(person, {name, age, location, moved=false}).
+-record(person, {name, age :: integer(), location, moved=false :: boolean()}).
%%%----------------------------------------------------------------------
%%% User interface functions
diff --git a/lib/tools/test/cprof_SUITE.erl b/lib/tools/test/cprof_SUITE.erl
index 7b22dea7ed..8beaf4f399 100644
--- a/lib/tools/test/cprof_SUITE.erl
+++ b/lib/tools/test/cprof_SUITE.erl
@@ -42,7 +42,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).
diff --git a/lib/tools/test/emem_SUITE.erl b/lib/tools/test/emem_SUITE.erl
index 95cda98558..93d21623ce 100644
--- a/lib/tools/test/emem_SUITE.erl
+++ b/lib/tools/test/emem_SUITE.erl
@@ -43,7 +43,7 @@
-include_lib("kernel/include/file.hrl").
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(DEFAULT_TIMEOUT, ?t:minutes(5)).
diff --git a/lib/tools/test/eprof_SUITE.erl b/lib/tools/test/eprof_SUITE.erl
index 5428643667..6274eabc37 100644
--- a/lib/tools/test/eprof_SUITE.erl
+++ b/lib/tools/test/eprof_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(eprof_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]).
diff --git a/lib/tools/test/fprof_SUITE.erl b/lib/tools/test/fprof_SUITE.erl
index e8f179c630..d1a673d6b7 100644
--- a/lib/tools/test/fprof_SUITE.erl
+++ b/lib/tools/test/fprof_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(fprof_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server framework exports
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/lib/tools/test/ignore_cores.erl b/lib/tools/test/ignore_cores.erl
index 13f34cd10f..e40b91392c 100644
--- a/lib/tools/test/ignore_cores.erl
+++ b/lib/tools/test/ignore_cores.erl
@@ -28,7 +28,7 @@
-module(ignore_cores).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]).
diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl
index 3b981a9303..773d805cd0 100644
--- a/lib/tools/test/instrument_SUITE.erl
+++ b/lib/tools/test/instrument_SUITE.erl
@@ -25,7 +25,7 @@
-export(['+Mim true'/1, '+Mis true'/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(_Case, Config) ->
?line Dog=?t:timetrap(10000),
diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl
index f3789a4137..47b8031bee 100644
--- a/lib/tools/test/lcnt_SUITE.erl
+++ b/lib/tools/test/lcnt_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(lcnt_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
diff --git a/lib/tools/test/make_SUITE.erl b/lib/tools/test/make_SUITE.erl
index 70bc8502bf..fdcc310df1 100644
--- a/lib/tools/test/make_SUITE.erl
+++ b/lib/tools/test/make_SUITE.erl
@@ -25,7 +25,7 @@
otp_6057_a/1, otp_6057_b/1, otp_6057_c/1,
otp_6057_end/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
diff --git a/lib/tools/test/tools_SUITE.erl b/lib/tools/test/tools_SUITE.erl
index 9403124c96..ae2a69305b 100644
--- a/lib/tools/test/tools_SUITE.erl
+++ b/lib/tools/test/tools_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(tools_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl
index ad47b31443..53aa80d2a3 100644
--- a/lib/tools/test/xref_SUITE.erl
+++ b/lib/tools/test/xref_SUITE.erl
@@ -30,7 +30,7 @@
-define(privdir, "xref_SUITE_priv").
-define(copydir, "xref_SUITE_priv/datacopy").
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(format(S, A), ok).
-define(datadir, ?config(data_dir, Conf)).
-define(privdir, ?config(priv_dir, Conf)).
@@ -1151,17 +1151,13 @@ read_expected(Version) ->
{POS8+4,{FF,{a,b,1}}},
{POS8+4,{FF,{erlang,apply,2}}},
{POS8+5,{FF,{erlang,apply,2}}},
- {POS8+6,{FF,{erlang,apply,3}}},
{POS8+6,{FF,{m,f,1}}},
- {POS8+7,{FF,{erlang,apply,3}}},
- {POS9+1,{FF,{erlang,apply,3}}},
{POS9+1,{FF,{read,bi,0}}},
{POS9+2,{FF,{a,b,1}}},
{POS9+2,{FF,{erlang,apply,2}}},
{POS9+3,{FF,{erlang,apply,2}}},
{POS9+4,{FF,{erlang,apply,2}}},
{POS9+4,{FF,{erlang,not_a_function,1}}},
- {POS9+5,{FF,{erlang,apply,3}}},
{POS9+5,{FF,{mod,func,2}}},
{POS9+6,{FF,{erlang,apply,1}}},
{POS9+7,{FF,{erlang,apply,2}}},
@@ -1169,17 +1165,11 @@ read_expected(Version) ->
{POS9+8,{FF,{q,f,1}}},
{POS10+4,{FF,{erlang,apply,2}}},
{POS10+5,{FF,{mod1,fun1,1}}},
- {POS11+1,{FF,{erlang,apply,3}}},
- {POS11+2,{FF,{erlang,apply,3}}},
- {POS11+3,{FF,{erlang,apply,3}}},
- {POS11+4,{FF,{erlang,apply,3}}},
{POS11+6,{FF,{erlang,apply,2}}},
{POS12+1,{FF,{erlang,apply,2}}},
{POS12+4,{FF,{erlang,apply,2}}},
- {POS12+5,{FF,{erlang,apply,3}}},
{POS12+5,{FF,{m3,f3,2}}},
{POS12+7,{FF,{erlang,apply,2}}},
- {POS12+8,{FF,{erlang,apply,3}}},
{POS13+1,{FF,{dm,df,1}}},
{POS13+6,{{read,bi,0},{foo,module_info,0}}},
{POS13+7,{{read,bi,0},{read,module_info,0}}},
@@ -1189,10 +1179,6 @@ read_expected(Version) ->
OK = case Version of
abstract_v1 ->
- [{POS8+3, {FF,{erlang,apply,3}}},
- {POS10+1, {FF,{erlang,apply,3}}},
- {POS10+6, {FF,{erlang,apply,3}}}]
- ++
[{0,{FF,{read,'$F_EXPR',178}}},
{0,{FF,{modul,'$F_EXPR',179}}}]
++ O1;
@@ -1213,13 +1199,25 @@ read_expected(Version) ->
{POS3+3, {FF,{erlang,spawn_link,3}}},
{POS3+4, {FF,{erlang,spawn_link,3}}},
{POS6+4, {FF,{erlang,spawn,3}}},
+ {POS8+6,{FF,{erlang,apply,3}}},
+ {POS8+7,{FF,{erlang,apply,3}}},
+ {POS9+1,{FF,{erlang,apply,3}}},
+ {POS9+5,{FF,{erlang,apply,3}}},
+ {POS11+1,{FF,{erlang,apply,3}}},
+ {POS11+2,{FF,{erlang,apply,3}}},
+ {POS11+3,{FF,{erlang,apply,3}}},
+ {POS11+4,{FF,{erlang,apply,3}}},
+ {POS12+5,{FF,{erlang,apply,3}}},
+ {POS12+8,{FF,{erlang,apply,3}}},
{POS13+5, {{read,bi,0},{erlang,length,1}}},
{POS14+3, {{read,bi,0},{erlang,length,1}}}],
%% Operators (OTP-8647):
OKB = case Version of
abstract_v1 ->
- [];
+ [{POS8+3, {FF,{erlang,apply,3}}},
+ {POS10+1, {FF,{erlang,apply,3}}},
+ {POS10+6, {FF,{erlang,apply,3}}}];
_ ->
[{POS13+16, {{read,bi,0},{erlang,'!',2}}},
{POS13+16, {{read,bi,0},{erlang,'-',1}}},
diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl
index 562530c868..5c82750a21 100644
--- a/lib/typer/src/typer.erl
+++ b/lib/typer/src/typer.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -137,11 +137,14 @@ extract(#analysis{macros = Macros,
NewCodeServer =
try
NewRecords = dialyzer_codeserver:get_temp_records(CodeServer1),
+ NewExpTypes = dialyzer_codeserver:get_temp_exported_types(CodeServer1),
+ case sets:size(NewExpTypes) of 0 -> ok end,
OldRecords = dialyzer_plt:get_types(TrustPLT), % XXX change to the PLT?
MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords),
CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1),
- CodeServer3 = dialyzer_utils:process_record_remote_types(CodeServer2),
- dialyzer_contracts:process_contract_remote_types(CodeServer3)
+ CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2),
+ CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3),
+ dialyzer_contracts:process_contract_remote_types(CodeServer4)
catch
throw:{error, ErrorMsg} ->
compile_error(ErrorMsg)
@@ -845,8 +848,7 @@ collect_info(Analysis) ->
%% io:format("Merged Records ~p",[MergedRecords]),
TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer),
TmpCServer2 =
- dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes,
- TmpCServer1),
+ dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1),
TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2),
dialyzer_contracts:process_contract_remote_types(TmpCServer3)
catch
diff --git a/lib/typer/test/Makefile b/lib/typer/test/Makefile
index d6dd22b6cf..fb5570d9f0 100644
--- a/lib/typer/test/Makefile
+++ b/lib/typer/test/Makefile
@@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/typer_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
EBIN = .
diff --git a/lib/webtool/AUTHORS b/lib/webtool/AUTHORS
deleted file mode 100644
index 5f173dd264..0000000000
--- a/lib/webtool/AUTHORS
+++ /dev/null
@@ -1,4 +0,0 @@
-Original Authors and Contributors:
-
-Siri Hansen
-Martin Gustafsson
diff --git a/lib/webtool/Makefile b/lib/webtool/Makefile
deleted file mode 100644
index 9afcb87af2..0000000000
--- a/lib/webtool/Makefile
+++ /dev/null
@@ -1,39 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2001-2009. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-
-SUB_DIRECTORIES = src priv doc/src
-
-include vsn.mk
-VSN = $(WEBTOOL_VSN)
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
-
-
diff --git a/lib/webtool/doc/html/.gitignore b/lib/webtool/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/webtool/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/webtool/doc/man1/.gitignore b/lib/webtool/doc/man1/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/webtool/doc/man1/.gitignore
+++ /dev/null
diff --git a/lib/webtool/doc/man3/.gitignore b/lib/webtool/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/webtool/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/webtool/doc/pdf/.gitignore b/lib/webtool/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/webtool/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/webtool/doc/src/Makefile b/lib/webtool/doc/src/Makefile
deleted file mode 100644
index 57de52a616..0000000000
--- a/lib/webtool/doc/src/Makefile
+++ /dev/null
@@ -1,132 +0,0 @@
-# ``Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT 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 $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(WEBTOOL_VSN)
-APPLICATION=webtool
-
-DOC_EXTRA_FRONT_PAGE_INFO=Important note: \
-The Webtool application is obsolete and will be removed \
-in the next major OTP release
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-
-XML_REF1_FILES = start_webtool.xml
-
-XML_REF3_FILES = webtool.xml
-
-XML_PART_FILES = \
- part.xml \
- part_notes.xml \
- part_notes_history.xml
-
-XML_CHAPTER_FILES = \
- webtool_chapter.xml \
- notes.xml \
- notes_history.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = \
- $(BOOK_FILES) $(XML_CHAPTER_FILES) \
- $(XML_PART_FILES) $(XML_REF3_FILES) \
- $(XML_REF1_FILES) $(XML_APPLICATION_FILES)
-
-GIF_FILES =
-
-# ----------------------------------------------------
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-
-MAN1_FILES = $(XML_REF1_FILES:%.xml=$(MAN1DIR)/%.1)
-MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
-
-HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
-
-TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-XML_FLAGS +=
-DVIPS_FLAGS +=
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-$(HTMLDIR)/%.gif: %.gif
- $(INSTALL_DATA) $< $@
-
-docs: pdf html man
-
-$(TOP_PDF_FILE): $(XML_FILES)
-
-pdf: $(TOP_PDF_FILE)
-
-html: gifs $(HTML_REF_MAN_FILE)
-
-
-clean clean_docs:
- rm -rf $(HTMLDIR)/*
- rm -f $(MAN1DIR)/*
- rm -f $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
-
-man: $(MAN1_FILES) $(MAN3_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-debug opt:
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_docs_spec: docs
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf"
- $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf"
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/html"
- $(INSTALL_DATA) $(HTMLDIR)/* \
- "$(RELSYSDIR)/doc/html"
- $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELEASE_PATH)/man/man1"
- $(INSTALL_DATA) $(MAN1_FILES) "$(RELEASE_PATH)/man/man1"
- $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3"
- $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3"
-
-release_spec:
-
diff --git a/lib/webtool/doc/src/book.xml b/lib/webtool/doc/src/book.xml
deleted file mode 100644
index feccee7c62..0000000000
--- a/lib/webtool/doc/src/book.xml
+++ /dev/null
@@ -1,48 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE book SYSTEM "book.dtd">
-
-<book xmlns:xi="http://www.w3.org/2001/XInclude">
- <header titlestyle="normal">
- <copyright>
- <year>2001</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>WebTool</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev>1.0</rev>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>WebTool</pagetext>
- <preamble>
- </preamble>
- <parts lift="no">
- <xi:include href="part.xml"/>
- </parts>
- <applications>
- <xi:include href="ref_man.xml"/>
- </applications>
- <releasenotes>
- <xi:include href="notes.xml"/>
- </releasenotes>
- <listofterms></listofterms>
- <index></index>
-</book>
-
diff --git a/lib/webtool/doc/src/fascicules.xml b/lib/webtool/doc/src/fascicules.xml
deleted file mode 100644
index 37feca543f..0000000000
--- a/lib/webtool/doc/src/fascicules.xml
+++ /dev/null
@@ -1,18 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE fascicules SYSTEM "fascicules.dtd">
-
-<fascicules>
- <fascicule file="part" href="part_frame.html" entry="no">
- User's Guide
- </fascicule>
- <fascicule file="ref_man" href="ref_man_frame.html" entry="yes">
- Reference Manual
- </fascicule>
- <fascicule file="part_notes" href="part_notes_frame.html" entry="no">
- Release Notes
- </fascicule>
- <fascicule file="" href="../../../../doc/print.html" entry="no">
- Off-Print
- </fascicule>
-</fascicules>
-
diff --git a/lib/webtool/doc/src/notes.xml b/lib/webtool/doc/src/notes.xml
deleted file mode 100644
index 21309261a8..0000000000
--- a/lib/webtool/doc/src/notes.xml
+++ /dev/null
@@ -1,253 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2004</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Webtool Release Notes</title>
- <prepared>otp_appnotes</prepared>
- <docno>nil</docno>
- <date>nil</date>
- <rev>nil</rev>
- <file>notes.xml</file>
- </header>
- <p>This document describes the changes made to the Webtool
- application.</p>
-
-<section><title>WebTool 0.9</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- The Webtool application has been marked as obsolete and
- will be removed from OTP in the next major release (OTP
- 19.0).</p>
- <p>
- Own Id: OTP-10922 Aux Id: OTP-12705 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>WebTool 0.8.10</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Application upgrade (appup) files are corrected for the
- following applications: </p>
- <p>
- <c>asn1, common_test, compiler, crypto, debugger,
- dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe,
- inets, observer, odbc, os_mon, otp_mibs, parsetools,
- percept, public_key, reltool, runtime_tools, ssh,
- syntax_tools, test_server, tools, typer, webtool, wx,
- xmerl</c></p>
- <p>
- A new test utility for testing appup files is added to
- test_server. This is now used by most applications in
- OTP.</p>
- <p>
- (Thanks to Tobias Schlager)</p>
- <p>
- Own Id: OTP-11744</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>WebTool 0.8.9.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Misc build updates</p>
- <p>
- Own Id: OTP-10784</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>WebTool 0.8.9.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Miscellaneous documentation build updates</p>
- <p>
- Own Id: OTP-9813</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>WebTool 0.8.9</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Do not install *.bat files on non-win32 machines (Thanks
- to Hans Ulrich Niedermann)</p>
- <p>
- Own Id: OTP-9515</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>WebTool 0.8.8</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Various small documentation fixes (Thanks to Bernard
- Duggan)</p>
- <p>
- Own Id: OTP-9172</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>WebTool 0.8.7</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Up until now Netscape has been the default web browser on
- Unix/Linux. Webtool has now been updated to start Firefox
- as default browser instead.</p>
- <p>
- Own Id: OTP-8651 Aux Id: OTP-8650 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>WebTool 0.8.6</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Misc updates</p>
- <p>
- Own Id: OTP-8456</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>WebTool 0.8.5</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- The documentation is now built with open source tools
- (xsltproc and fop) that exists on most platforms. One
- visible change is that the frames are removed.</p>
- <p>
- Own Id: OTP-8201</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>WebTool 0.8.4</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>The copyright notices have been updated.</p>
- <p>
- Own Id: OTP-7851</p>
- </item>
- </list>
- </section>
-
-</section>
-<section><title>WebTool 0.8.3.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Minor updates.</p>
- <p>
- Own Id: OTP-6998</p>
- </item>
- </list>
- </section>
-
-</section>
-
- <section>
- <title>WebTool 0.8.3.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Minor Makefile changes.</p>
- <p>Own Id: OTP-6689</p>
- </item>
- <item>
- <p>Obsolete guard tests (such as list()) have been replaced
- with the modern guard tests (such as is_list()).</p>
- <p>Own Id: OTP-6725</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>WebTool 0.8.3</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Removed some dead code discovered by Dialyzer.</p>
- <p>Own Id: OTP-6041</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/webtool/doc/src/notes_history.xml b/lib/webtool/doc/src/notes_history.xml
deleted file mode 100644
index 792475d948..0000000000
--- a/lib/webtool/doc/src/notes_history.xml
+++ /dev/null
@@ -1,74 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2006</year>
- <year>2013</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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.
- </legalnotice>
-
- <title>Webtool Release Notes History</title>
- <prepared>otp_appnotes</prepared>
- <docno>nil</docno>
- <date>nil</date>
- <rev>nil</rev>
- </header>
-
- <section>
- <title>Webtool 0.8.2</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Bugfix: <c>webtool</c> crashed when trying to find a free
- port number if connection failed with other reason than
- <c>econnrefused</c>.</p>
- <p>Own Id: OTP-5166</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Misc improvements:</p>
- <list type="bulleted">
- <item>The function <c>debug_app/1</c> and some error
- printouts are added to simplify debugging of own
- application.</item>
- <item>Multiple webtool instances can now be started on
- the same host. If the default port (8888) is in use, port
- 8889 is tried. If 8889 is also used, 8890 is tried and so
- on. Max number of ports tried is 256.</item>
- <item><em>Incompatible:</em> If <c>Data</c> is set to
- <c>PortNumber</c> in <c>start(Path,Data)</c>, the default
- data will be used for ip-number (<c>127.0.0.1</c>) and
- server name (<c>localhost</c>).</item>
- </list>
- <p>*** POTENTIAL INCOMPATIBILITY ***</p>
- <p>Own Id: OTP-4724</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/webtool/doc/src/part.xml b/lib/webtool/doc/src/part.xml
deleted file mode 100644
index b0c4ee310d..0000000000
--- a/lib/webtool/doc/src/part.xml
+++ /dev/null
@@ -1,38 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>2001</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>WebTool User's Guide</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <description>
- <p><em>WebTool</em> provides a easy way to use web based tools with
- Erlang/OTP. It configures and starts a webserver as well as all
- available tools.</p>
- </description>
- <xi:include href="webtool_chapter.xml"/>
-</part>
-
diff --git a/lib/webtool/doc/src/part_notes.xml b/lib/webtool/doc/src/part_notes.xml
deleted file mode 100644
index db2b790f3f..0000000000
--- a/lib/webtool/doc/src/part_notes.xml
+++ /dev/null
@@ -1,40 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>2004</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>WebTool Release Notes</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <description>
- <p><em>WebTool</em> provides an easy way to use web based tools with
- Erlang/OTP. It configures and starts a webserver as well as all
- available tools.</p>
- <p>For information about older versions, see
- <url href="part_notes_history_frame.html">Release Notes History</url>.</p>
- </description>
- <xi:include href="notes"/>
-</part>
-
diff --git a/lib/webtool/doc/src/part_notes_history.xml b/lib/webtool/doc/src/part_notes_history.xml
deleted file mode 100644
index 50ce62e58d..0000000000
--- a/lib/webtool/doc/src/part_notes_history.xml
+++ /dev/null
@@ -1,40 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part>
- <header>
- <copyright>
- <year>2006</year>
- <year>2013</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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.
- </legalnotice>
-
- <title>WebTool Release Notes History</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <description>
- <p><em>WebTool</em> provides a easy way to use web based tools with
- Erlang/OTP. It configures and starts a webserver as well as all
- available tools.</p>
- </description>
- <include file="notes_history"></include>
-</part>
-
diff --git a/lib/webtool/doc/src/ref_man.xml b/lib/webtool/doc/src/ref_man.xml
deleted file mode 100644
index aa81392b11..0000000000
--- a/lib/webtool/doc/src/ref_man.xml
+++ /dev/null
@@ -1,39 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE application SYSTEM "application.dtd">
-
-<application xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>2001</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>WebTool Reference Manual</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <description>
- <p><em>WebTool</em> provides an easy way to use web based tools with
- Erlang/OTP. It configures and starts a webserver as well as all
- available tools.</p>
- </description>
- <xi:include href="webtool.xml"/>
- <xi:include href="start_webtool.xml"/>
-</application>
-
diff --git a/lib/webtool/doc/src/start_webtool.xml b/lib/webtool/doc/src/start_webtool.xml
deleted file mode 100644
index e9c94c4271..0000000000
--- a/lib/webtool/doc/src/start_webtool.xml
+++ /dev/null
@@ -1,104 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE comref SYSTEM "comref.dtd">
-
-<comref>
- <header>
- <copyright>
- <year>2003</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>start_webtool</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno>1</docno>
- <approved></approved>
- <checked></checked>
- <date>2003-06-18</date>
- <rev></rev>
- <file>start_webtool.sgml</file>
- </header>
- <com>start_webtool</com>
- <comsummary>WebTool Start Script</comsummary>
- <description>
- <p>The <c>start_webtool</c> script starts WebTool, a WebTool
- application and a web browser pointing to this application.</p>
- </description>
- <funcs>
- <func>
- <name>start_webtool application [ browser ]</name>
- <fsummary>Start a WebTool Application</fsummary>
- <desc>
- <p>Starts WebTool, the given WebTool Application and a web
- browser pointing to this application.
- </p>
- <p>If no argument is given, a list of available applications
- is displayed, e.g.</p>
- <pre>
->start_webtool
-Starting webtool...
-WebTool is available at http://localhost:8888/
-Or http://127.0.0.1:8888/
-
-Usage: start_webtool application [ browser ]
-
-Available applications are: [orber,appmon,crashdump_viewer,webcover]
-Default browser is 'iexplore' (Internet Explorer) on Windows or else 'firefox' </pre>
- <p>To start any of the listed applications, give the
- application name as the first argument, e.g.</p>
- <pre>
->start_webtool webcover
-Starting webtool...
-WebTool is available at http://localhost:8888/
-Or http://127.0.0.1:8888/
-Starting webcover...
-Sending URL to netscape...done </pre>
- <p>The WebTool application WebCover is then started and the
- default browser is used. The default browser is Internet
- Explorer on Windows or else Firefox.
- </p>
- <p>To use another browser, give the browser's start command
- as the second argument, e.g.</p>
- <pre>
->start_webtool webcover mozilla
-Starting webtool...
-WebTool is available at http://localhost:8888/
-Or http://127.0.0.1:8888/
-Starting webcover...
-Sending URL to mozilla...done </pre>
- <p>If the given browser name is not known to WebTool, WebTool
- will run it as a command with the start URL as the only
- argument, e.g.</p>
- <pre>
->start_webtool webcover mybrowser
-Starting webtool...
-WebTool is available at http://localhost:8888/
-Or http://127.0.0.1:8888/
-Starting webcover...
-Starting mybrowser... </pre>
- <p>Here the command <c>"mybrowser http://localhost:8888/webcover"</c> is executed.
- </p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>See Also</title>
- <p><seealso marker="webtool">webtool(3)</seealso></p>
- </section>
-</comref>
-
diff --git a/lib/webtool/doc/src/webtool.xml b/lib/webtool/doc/src/webtool.xml
deleted file mode 100644
index 2647518dae..0000000000
--- a/lib/webtool/doc/src/webtool.xml
+++ /dev/null
@@ -1,157 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2001</year>
- <year>2013</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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.
- </legalnotice>
-
- <title>webtool</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <module>webtool</module>
- <modulesummary>WebTool is a tool used to simplify the implementation of web based tools with Erlang/OTP.</modulesummary>
- <description>
- <p>WebTool makes it easy to use web based tools with Erlang/OTP. WebTool
- configures and starts the webserver httpd.</p>
- </description>
- <funcs>
- <func>
- <name>start()-> {ok,Pid}| {stop,Reason}</name>
- <fsummary>Start WebTool.</fsummary>
- <desc>
- <p>Start WebTool with default data, i.e. port 8888, ip-number
- 127.0.0.1, and server-name <c>localhost</c>. If port 8888 is
- in use, port 8889 is tried instead. If 8889 is also in use,
- 8890 is tried and so on. Max number of ports tried is 256.
- </p>
- <p>The <c>mime.types</c> file and WebTool's own HTML files
- are assumed to be in the directory
- <c><![CDATA[webtool-<vsn>/priv/root/conf]]></c>.</p>
- </desc>
- </func>
- <func>
- <name>start(Path,Data)->{ok,Pid}|{stop,Reason}</name>
- <fsummary>Start WebTool with default configuration.</fsummary>
- <type>
- <v>Path = string() | standard_path</v>
- <v>Data = [Port,Address,Name] | PortNumber | standard_data</v>
- <v>Port = {port,PortNumber}</v>
- <v>Address = {bind_address,IpNumber}</v>
- <v>Name = {server_name,ServerName}</v>
- <v>PortNumber = integer()</v>
- <v>IpNumber = tuple(), e.g. {127,0,0,1}</v>
- <v>ServerName = string()</v>
- <v>Pid = pid()</v>
- </type>
- <desc>
- <p>Use this function to start WebTool if the default port,
- ip-number,servername or path can not be used.</p>
- <p><c>Path</c> is the directory where the <c>mime.types</c>
- file and WebTool's own HTML files are located. By default
- this is <c><![CDATA[webtool-<vsn>/priv]]></c>, and in most cases there
- is no need to change this. If <c>Path</c> is set to
- <c>standard_path</c> the default will be used.</p>
- <p>If <c>Data</c> is set to <c>PortNumber</c>, the default data
- will be used for ip-number (<c>127.0.0.1</c>) and server
- name (<c>localhost</c>).</p>
- </desc>
- </func>
- <func>
- <name>stop()->void</name>
- <fsummary>Stop WebTool.</fsummary>
- <desc>
- <p>Stop WebTool and the tools started by WebTool.</p>
- </desc>
- </func>
- <func>
- <name>debug_app(Module)->void</name>
- <fsummary>Debug a WebTool application.</fsummary>
- <type>
- <v>Module = atom()</v>
- </type>
- <desc>
- <p>Debug a WebTool application by tracing all functions in the
- given module which are called from WebTool.</p>
- </desc>
- </func>
- <func>
- <name>stop_debug()->void</name>
- <fsummary>Stop debugging an application and format the trace log.</fsummary>
- <desc>
- <p>Stop the tracing started by <c>debug_app/1</c>, and format
- the trace log.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>CALLBACK FUNCTIONS</title>
- <p>The following callback function must be implemented by each web
- based tool that will be used via WebTool. When started, WebTool
- searches the Erlang code path for *.tool files to locate all web
- based tools and their callback functions. See the <seealso marker="webtool_chapter">WebTool User's Guide</seealso> for more
- information about the *.tool files.</p>
- </section>
- <funcs>
- <func>
- <name>Module:Func(Data)-> {Name,WebData}|error</name>
- <fsummary>Returns configuration data needed by WebTool to configure and start a tool.</fsummary>
- <type>
- <v>Data = term()</v>
- <v>Name = atom()</v>
- <v>WebData = [WebOptions]</v>
- <v>WebOptions = LinkData | Alias | Start</v>
- <v>LinkData = {web_data,{ToolName,Url}}</v>
- <v>Alias = {alias,{VirtualPath,RealPath}} | {alias,{erl_alias,Path,[Modules]}</v>
- <v>Start = {start,StartData}</v>
- <v>ToolName = Url = VirtualPath = RealPath = Path = string()</v>
- <v>Modules = atom()</v>
- <v>StartData = AppData | ChildSpec | Func</v>
- <v>AppData = {app,AppName}</v>
- <v>ChildSpec = {child,child_spec()}</v>
- <d>See the Reference Manual for the module supervisor in the STDLIB application for details about child_spec().</d>
- <v>Func = {func,{StartMod,StartFunc,StartArg}, {StopMod,StopFunc,StopArg}}</v>
- <v>AppName = StartMod = StartFunc = StopMod = StopFunc =atom()</v>
- <v>StartArg = StopArg = [term()]</v>
- </type>
- <desc>
- <p>This is the configuration function (<c>config_func</c>)
- which must be stated in the <c>*.tool</c> file.</p>
- <p>The function is called by WebTool at startup to retrieve the
- data needed to start and configure the tool. <c>LinkData</c> is
- used by WebTool to create the link to the tool. <c>Alias</c> is
- used to create the aliases needed by the webserver. <c>Start</c>
- is used to start and stop the tool.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>See Also</title>
- <p><seealso marker="start_webtool">start_webtool(1)</seealso>,
- <seealso marker="webtool_chapter">WebTool User's Guide</seealso></p>
- </section>
-</erlref>
-
diff --git a/lib/webtool/doc/src/webtool_chapter.xml b/lib/webtool/doc/src/webtool_chapter.xml
deleted file mode 100644
index 160a42f855..0000000000
--- a/lib/webtool/doc/src/webtool_chapter.xml
+++ /dev/null
@@ -1,246 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2013</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>WebTool User Guide</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>webtool_chapter.xml</file>
- </header>
-
- <section>
- <title>Introduction </title>
- <p>WebTool provides an easy and efficient way to implement web
- based tools with Erlang/OTP. WebTool configures and starts the
- webserver and the various web based tools.</p>
- <p>All tools that shall run under WebTool must have a *.tool
- file in the code path or in its priv directory. When WebTool
- starts it searches the code path for such files. For each
- <c>ebin</c> directory in the path, the <c>priv</c> directory is
- also searched. The *.tool files contain the configuration data
- for each web based tool.</p>
- </section>
-
- <section>
- <title>Starting WebTool</title>
- <p>Start WebTool by calling the function <c>webtool:start/0</c> or
- <c>webtool:start/2</c>. If <c>webtool:start/0</c> is used the
- start page of WebTool is available at
- <em>http://localhost:8888/</em> or
- <em>http://127.0.0.1:8888/</em>, and the directory containing
- the root directory for the webserver, is assumed to be
- <c><![CDATA[webtool-<vsn>/priv]]></c>.</p>
- <p>Use <c>webtool:start/2</c> if the default path for the root
- directory, port, ip-number or server name can not be used. See
- the Reference Manual for <seealso marker="webtool">webtool</seealso> for more information.</p>
- <p>WebTool, with the default configuration as in <c>start/0</c>,
- can also be started with the <c>start_webtool</c> script which
- is available in the <c>priv</c> directory of the WebTool
- application. See the Reference Manual for <seealso marker="start_webtool">start_webtool</seealso> for further
- information about this script. For Windows users, the batch file
- <c>start_webtool.bat</c> can be used for the same purpose.</p>
- </section>
-
- <section>
- <title>Using WebTool</title>
- <p>Start WebTool and point the browser to the corresponding URL.
- At the top of the page there is a frame with a link named
- <em>WebTool</em>. Click that link and a page where it is
- possible to start the available tools will appear in the main
- frame.</p>
- </section>
-
- <section>
- <title>Start a web based tool</title>
- <p>Click on the link labeled <em>WebTool</em> in the topmost frame,
- select the checkbox for each tool to start and
- click on the button labeled <em>Start</em>. A link to each tool
- that WebTool succeeded to start will appear in the topmost frame.</p>
- </section>
-
- <section>
- <title>Stop a web based tool</title>
- <p>Click on the link labeled <em>WebTool</em> in the topmost
- frame. Select <em>Stop Tools</em> in the left frame. Select the
- checkbox for each tool to stop and click on the button labeled
- <em>Stop</em>.</p>
- </section>
-
- <section>
- <title>Develop new web based tools</title>
- <p>WebTool can be used as a framework when developing new web based
- tools.</p>
- <p>A web based tool running under WebTool will typically consist of
- three parts.</p>
- <list type="bulleted">
- <item>A *.tool file which defines how WebTool can find the tool's
- configuration data</item>
- <item>The Erlang code generating the web interface to the tool (HTML
- code)</item>
- <item>The tool itself.</item>
- </list>
- <p>In most cases it is a good idea to separate the code for
- creation of the html-pages and the code for the logic. This
- increases the readability of the code and the logic might be
- possible to reuse.</p>
-
- <section>
- <title>The *.tool file</title>
- <p>When WebTool starts it searches the current path for
- <c>*.tool</c> files to find all available tools. The *.tool
- file contains a version identifier and a list of tuples which
- is the configuration data. The version identifier specifies
- the *.tool file version, i.e. not the version of
- webtool. Currently the only valid version is "1.2" and the
- only valid configuration tag is
- <c>config_func</c>. <c>config_func</c> specifies which
- function WebTool must call to get further configuration data
- for the tool. This means that a *.tool file generally must
- look like this:</p>
- <code type="none">
- {version,"1.2"}.
- [{config_func,{Module,Function,Arguments}}]. </code>
- <p><c>Module</c> is the name of the module where the callback
- function is defined. <c>Function</c> is the name of the
- callback function, and <c>Arguments</c> is the list of
- arguments to the callback function.</p>
- </section>
-
- <section>
- <title>The configuration function</title>
- <p>The *.tool file points out a configuration function. This
- function must return a list of configuration parameters (see
- the Reference Manual for <seealso marker="webtool">webtool</seealso>).</p>
- <p>The <c>web_data</c> parameter is mandatory and it specifies
- the name of the tool and the link to the tool's start
- page. All other parameters are optional.</p>
- <p>If the tool requires any processes to run, the <c>start</c>
- parameter specifies the function that WebTool must call in
- order to start the process(es).</p>
- <p>The <c>alias</c> parameters are passed directly on to the
- webserver (INETS). The webserver has three ways to create
- dynamic web pages CGI, Eval Scheme and Erl Scheme. All tools
- running under WebTool must use Erl Scheme.</p>
- <p>Erl Scheme tries to resemble plain CGI. The big difference is
- that Erl Scheme can only execute Erlang code. The code will
- furthermore be executed on the same instance as the webserver.</p>
- <p>An URL which calls an Erlang function with Erl Scheme can have
- the following syntax:</p>
- <code type="none"><![CDATA[
-http://Servername:Port/ErlScriptAlias/Mod/Func<?QueryString> ]]></code>
- <p>An <c>alias</c> parameter in the configuration function can be
- an ErlScriptAlias as used in the above URL. The definition of
- an ErlScriptAlias shall be like this:</p>
- <p><c>{alias,{erl_alias,Path,[Modules]}}</c>, e.g.</p>
- <p><c>{alias,{erl_alias,"/testtool",[helloworld]}}</c></p>
- <p>The following URL will then cause a call to the function
- helloworld:helloworld/2 (if WebTool is started with default
- settings i.e. servername "localhost" and port 8888):</p>
- <p><c>http://localhost:8888/testtool/helloworld/helloworld</c></p>
- <p>Note that the module <c>helloworld</c> must be in the code
- path of the node running WebTool.</p>
- <p>Functions that are called via the Erl Scheme must take two
- arguments, <c>Environment</c> and <c>Input</c>.
- </p>
- <list type="bulleted">
- <item><c>Environment</c> is a list of key/value tuples.</item>
- <item><c>Input</c> is the part of the URL after the "?", i.e. the
- part of the URL containing name-value pairs. If the page was
- called with the URL:
- <br></br>
-<c><![CDATA[http://localhost:8888/testtool/helloworld/helloworld?input1=one&amp;input2=two]]></c> <br></br>
-<c>Input</c> will be the string
- <c><![CDATA["input1=one&amp;input2=two"]]></c>. In the module
- <c>httpd</c> in the INETS application there is a function
- <c>parse_query</c> which will parse such a string and return
- a list of key-value tuples.</item>
- </list>
- <p>An <c>alias</c> parameter in the configuration function can
- also be a normal path alias. This can e.g. be used to point
- out a directory where HTML files are stored. The following
- definition states that the URL
- <c>http://localhost:8888/mytool_home/</c> really points to the
- directory <c>/usr/local/otp/lib/myapp-1.0/priv</c>:</p>
- <p><c>{alias,{"/mytool_home","/usr/local/otp/lib/myapp-1.0/priv"}}</c></p>
- <p>See the INETS documentation, especially the module
- <c>mod_esi</c>, for a more in depth coverage of the Erl Scheme.</p>
- </section>
-
- <section>
- <title>A small example</title>
- <p>A Hello World example that uses Erl Scheme would look like
- this. Note that this example does not have a process running
- and thus does not need a <c>start</c> parameter in the
- configuration function.
- </p>
- <p><em>helloworld.erl:</em></p>
- <pre>
- -module(helloworld).
- -export([config_data/0]).
- -export([helloworld/2]).
-
- config_data()->
- {testtool,
- [{web_data,{"TestTool","/testtool/helloworld/helloworld"}},
- {alias,{erl_alias,"/testtool",[helloworld]}}]}.
-
- helloworld(_Env,_Input)-&gt;
- [header(),html_header(),helloworld_body(),html_end()].
-
- header() -&gt;
- header("text/html").
-
- header(MimeType) -&gt;
- "Content-type: " ++ MimeType ++ "\r\n\r\n".
-
- html_header() -&gt;
- "&lt;HTML&gt;
- &lt;HEAD&gt;
- &lt;TITLE&gt;Hello world Example &lt;/TITLE&gt;
- &lt;/HEAD&gt;\n".
-
- helloworld_body()-&gt;
- "&lt;BODY&gt;Hello World&lt;/BODY&gt;".
-
- html_end()-&gt;
- "&lt;/HTML&gt;".
- </pre>
- <p>To use this example with WebTool a *.tool file must be created
- and added to a directory in the current path, e.g. the same
- directory as the compiled <c>helloworld.beam</c>.</p>
- <p><em>testtool.tool:</em></p>
- <code type="none">
- {version,"1.2"}.
- [{config_func, {helloworld,config_data,[]}}].
- </code>
- <p>When <c>helloworld.erl</c> is compiled, start WebTool by
- calling the function <c>webtool:start()</c> and point your
- browser to <em>http://localhost:8888/</em>. Select WebTool in
- the topmost frame and start TestTool from the web page. Click
- on the link labeled <em>TestTool</em> in the topmost frame.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/webtool/ebin/.gitignore b/lib/webtool/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/webtool/ebin/.gitignore
+++ /dev/null
diff --git a/lib/webtool/info b/lib/webtool/info
deleted file mode 100644
index 4d8dc6f2cb..0000000000
--- a/lib/webtool/info
+++ /dev/null
@@ -1,2 +0,0 @@
-group: tools
-short: A tool that simplifying the use of web based Erlang tools
diff --git a/lib/webtool/priv/Makefile b/lib/webtool/priv/Makefile
deleted file mode 100644
index 4963767a4d..0000000000
--- a/lib/webtool/priv/Makefile
+++ /dev/null
@@ -1,82 +0,0 @@
-# ``Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT 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 $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(WEBTOOL_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/webtool-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-WEBSERVER_CONFIG_FILES = root/conf/mime.types
-
-HTDOCS_FILES = root/doc/index.html \
- root/doc/tool_management.html \
- root/doc/start_info.html
-
-ifeq ($(findstring win32,$(TARGET)),win32)
-WIN32_SCRIPTS= bin/start_webtool.bat
-else
-WIN32_SCRIPTS=
-endif
-SCRIPTS = bin/start_webtool $(WIN32_SCRIPTS)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_COMPILE_FLAGS +=
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-debug opt:
-
-clean:
-
-docs:
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/priv"
- $(INSTALL_DIR) "$(RELSYSDIR)/priv/root"
- $(INSTALL_DIR) "$(RELSYSDIR)/priv/root/conf"
- $(INSTALL_DIR) "$(RELSYSDIR)/priv/root/doc"
- $(INSTALL_DATA) $(HTDOCS_FILES) "$(RELSYSDIR)/priv/root/doc"
- $(INSTALL_DATA) $(WEBSERVER_CONFIG_FILES) "$(RELSYSDIR)/priv/root/conf"
- $(INSTALL_DIR) "$(RELSYSDIR)/priv/bin"
- $(INSTALL_SCRIPT) $(SCRIPTS) "$(RELSYSDIR)/priv/bin"
-
-release_docs_spec:
-
-
diff --git a/lib/webtool/priv/bin/start_webtool b/lib/webtool/priv/bin/start_webtool
deleted file mode 100755
index e552fb5af0..0000000000
--- a/lib/webtool/priv/bin/start_webtool
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/sh
-
-erl -sname webtool -s webtool script_start $@
diff --git a/lib/webtool/priv/bin/start_webtool.bat b/lib/webtool/priv/bin/start_webtool.bat
deleted file mode 100644
index cd16aa6200..0000000000
--- a/lib/webtool/priv/bin/start_webtool.bat
+++ /dev/null
@@ -1,2 +0,0 @@
-@ECHO OFF
-CALL erl -sname webtool -s webtool script_start %* -s erlang halt \ No newline at end of file
diff --git a/lib/webtool/priv/root/conf/mime.types b/lib/webtool/priv/root/conf/mime.types
deleted file mode 100644
index 32f7cd853c..0000000000
--- a/lib/webtool/priv/root/conf/mime.types
+++ /dev/null
@@ -1,99 +0,0 @@
-# This is a comment. I love comments.
-
-application/activemessage
-application/andrew-inset
-application/applefile
-application/atomicmail
-application/dca-rft
-application/dec-dx
-application/mac-binhex40 hqx
-application/mac-compactpro cpt
-application/macwriteii
-application/msword doc
-application/news-message-id
-application/news-transmission
-application/octet-stream bin dms lha lzh exe class
-application/oda oda
-application/pdf pdf
-application/postscript ai eps ps
-application/powerpoint ppt
-application/remote-printing
-application/rtf rtf
-application/slate
-application/wita
-application/wordperfect5.1
-application/x-bcpio bcpio
-application/x-cdlink vcd
-application/x-compress Z
-application/x-cpio cpio
-application/x-csh csh
-application/x-director dcr dir dxr
-application/x-dvi dvi
-application/x-gtar gtar
-application/x-gzip gz
-application/x-hdf hdf
-application/x-httpd-cgi cgi
-application/x-koan skp skd skt skm
-application/x-latex latex
-application/x-mif mif
-application/x-netcdf nc cdf
-application/x-sh sh
-application/x-shar shar
-application/x-stuffit sit
-application/x-sv4cpio sv4cpio
-application/x-sv4crc sv4crc
-application/x-tar tar
-application/x-tcl tcl
-application/x-tex tex
-application/x-texinfo texinfo texi
-application/x-troff t tr roff
-application/x-troff-man man
-application/x-troff-me me
-application/x-troff-ms ms
-application/x-ustar ustar
-application/x-wais-source src
-application/zip zip
-audio/basic au snd
-audio/mpeg mpga mp2
-audio/x-aiff aif aiff aifc
-audio/x-pn-realaudio ram
-audio/x-pn-realaudio-plugin rpm
-audio/x-realaudio ra
-audio/x-wav wav
-chemical/x-pdb pdb xyz
-image/gif gif
-image/ief ief
-image/jpeg jpeg jpg jpe
-image/png png
-image/tiff tiff tif
-image/x-cmu-raster ras
-image/x-portable-anymap pnm
-image/x-portable-bitmap pbm
-image/x-portable-graymap pgm
-image/x-portable-pixmap ppm
-image/x-rgb rgb
-image/x-xbitmap xbm
-image/x-xpixmap xpm
-image/x-xwindowdump xwd
-message/external-body
-message/news
-message/partial
-message/rfc822
-multipart/alternative
-multipart/appledouble
-multipart/digest
-multipart/mixed
-multipart/parallel
-text/html html htm
-text/x-server-parsed-html shtml
-text/plain txt
-text/richtext rtx
-text/tab-separated-values tsv
-text/x-setext etx
-text/x-sgml sgml sgm
-video/mpeg mpeg mpg mpe
-video/quicktime qt mov
-video/x-msvideo avi
-video/x-sgi-movie movie
-x-conference/x-cooltalk ice
-x-world/x-vrml wrl vrml
diff --git a/lib/webtool/priv/root/doc/index.html b/lib/webtool/priv/root/doc/index.html
deleted file mode 100644
index 9fbb143cc7..0000000000
--- a/lib/webtool/priv/root/doc/index.html
+++ /dev/null
@@ -1,11 +0,0 @@
-<HTML>
-<HEAD>
-<TITLE>Erlang WebTool</TITLE>
-</HEAD>
-<FRAMESET ROWS="60,*">
-<FRAME NAME="top1" SRC="webtool/webtool/started_tools">
-<FRAME NAME="app_frame" SRC="./start_info.html">
-</FRAMESET>
-</HTML>
-
-
diff --git a/lib/webtool/priv/root/doc/start_info.html b/lib/webtool/priv/root/doc/start_info.html
deleted file mode 100644
index fcf44433f1..0000000000
--- a/lib/webtool/priv/root/doc/start_info.html
+++ /dev/null
@@ -1,28 +0,0 @@
-<HTML>
-<HEAD>
-</HEAD>
-<BODY BGCOLOR="#FFFFFF">
-<TABLE WIDTH=100% HEIGHT=100%>
-<TR VALIGN="middle">
-<TD ALIGN="center">
-
-<TABLE WIDTH="60%">
-<TR>
-<TD ALIGN="center"><FONT SIZE=6>Welcome <BR> to<BR> WebTool</FONT></TD>
-</TR>
-
-<TR>
-<TD><BR><BR><BR><BR>
-</TD>
-</TR>
-
-<TR>
-<TD ALIGN="center">Click on the link WebTool on the top of the page, or <A HREF=tool_management.html>here</a> to start the Web based tools.</TD>
-</TR>
-</TABLE>
-
-</TD>
-</TR>
-</TABLE>
-</BODY>
-</HTML> \ No newline at end of file
diff --git a/lib/webtool/priv/root/doc/tool_management.html b/lib/webtool/priv/root/doc/tool_management.html
deleted file mode 100644
index 19d9dbcb9e..0000000000
--- a/lib/webtool/priv/root/doc/tool_management.html
+++ /dev/null
@@ -1,9 +0,0 @@
-<HTML>
-<HEAD>
-<TITLE>Erlang WebTool </TITLE>
-</HEAD>
-<FRAMESET COLS="200,*">
-<FRAME NAME="left" SRC="/webtool/webtool/toolbar">
-<FRAME NAME="right" SRC="/webtool/webtool/start_tools">
-</FRAMESET>
-
diff --git a/lib/webtool/src/webtool.app.src b/lib/webtool/src/webtool.app.src
deleted file mode 100644
index 6b9750c2b4..0000000000
--- a/lib/webtool/src/webtool.app.src
+++ /dev/null
@@ -1,28 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-{application,webtool,
- [{description,"Toolbar lookalike for the web"},
- {vsn,"%VSN%"},
- {modules,[webtool,webtool_sup]},
- {registered,[web_tool,websup]},
- {applications,[kernel,stdlib]},
- {runtime_dependencies, ["stdlib-2.0","observer-2.0","kernel-3.0",
- "inets-5.10","erts-6.0"]}]}.
-
diff --git a/lib/webtool/src/webtool.appup.src b/lib/webtool/src/webtool.appup.src
deleted file mode 100644
index 1394d0d6d5..0000000000
--- a/lib/webtool/src/webtool.appup.src
+++ /dev/null
@@ -1,22 +0,0 @@
-%% -*- erlang -*-
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2014. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-{"%VSN%",
- [{<<".*">>,[{restart_application, webtool}]}],
- [{<<".*">>,[{restart_application, webtool}]}]
-}.
diff --git a/lib/webtool/src/webtool.erl b/lib/webtool/src/webtool.erl
deleted file mode 100644
index 80dad53f8f..0000000000
--- a/lib/webtool/src/webtool.erl
+++ /dev/null
@@ -1,1208 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(webtool).
--behaviour(gen_server).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% The general idea is: %%
-%% %%
-%% %%
-%% 1. Scan through the path for *.tool files and find all the web %%
-%% based tools. Query each tool for configuration data. %%
-%% 2. Add Alias for Erlscript and html for each tool to %%
-%% the webserver configuration data. %%
-%% 3. Start the webserver. %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% API functions
--export([start/0, start/2, stop/0]).
-
-%% Starting Webtool from a shell script
--export([script_start/0, script_start/1]).
-
-%% Web api
--export([started_tools/2, toolbar/2, start_tools/2, stop_tools/2]).
-
-%% API against other tools
--export([is_localhost/0]).
-
-%% Debug export s
--export([get_tools1/1]).
--export([debug/1, stop_debug/0, debug_app/1]).
-
-%% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
- terminate/2, code_change/3]).
-
--include_lib("kernel/include/file.hrl").
--include_lib("stdlib/include/ms_transform.hrl").
-
--record(state,{priv_dir,app_data,supvis,web_data,started=[]}).
-
--define(MAX_NUMBER_OF_WEBTOOLS,256).
--define(DEFAULT_PORT,8888).% must be >1024 or the user must be root on unix
--define(DEFAULT_ADDR,{127,0,0,1}).
-
--define(WEBTOOL_ALIAS,{webtool,[{alias,{erl_alias,"/webtool",[webtool]}}]}).
--define(HEADER,"Pragma:no-cache\r\n Content-type: text/html\r\n\r\n").
--define(HTML_HEADER,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool</TITLE>\r\n</HEAD>\r\n<BODY BGCOLOR=\"#FFFFFF\">\r\n").
--define(HTML_HEADER_RELOAD,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool
- </TITLE>\r\n</HEAD>\r\n
- <BODY BGCOLOR=\"#FFFFFF\" onLoad=reloadCompiledList()>\r\n").
-
--define(HTML_END,"</BODY></HTML>").
-
--define(SEND_URL_TIMEOUT,5000).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% For debugging only. %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Start tracing with
-%% debug(Functions).
-%% Functions = local | global | FunctionList
-%% FunctionList = [Function]
-%% Function = {FunctionName,Arity} | FunctionName |
-%% {Module, FunctionName, Arity} | {Module,FunctionName}
-debug(F) ->
- ttb:tracer(all,[{file,"webtool.trc"}]), % tracing all nodes
- ttb:p(all,[call,timestamp]),
- MS = [{'_',[],[{return_trace},{message,{caller}}]}],
- tp(F,MS),
- ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func
- ok.
-tp(local,MS) -> % all functions
- ttb:tpl(?MODULE,MS);
-tp(global,MS) -> % all exported functions
- ttb:tp(?MODULE,MS);
-tp([{M,F,A}|T],MS) -> % Other module
- ttb:tpl(M,F,A,MS),
- tp(T,MS);
-tp([{M,F}|T],MS) when is_atom(F) -> % Other module
- ttb:tpl(M,F,MS),
- tp(T,MS);
-tp([{F,A}|T],MS) -> % function/arity
- ttb:tpl(?MODULE,F,A,MS),
- tp(T,MS);
-tp([F|T],MS) -> % function
- ttb:tpl(?MODULE,F,MS),
- tp(T,MS);
-tp([],_MS) ->
- ok.
-stop_debug() ->
- ttb:stop([format]).
-
-debug_app(Mod) ->
- ttb:tracer(all,[{file,"webtool_app.trc"},{handler,{fun out/4,true}}]),
- ttb:p(all,[call,timestamp]),
- MS = [{'_',[],[{return_trace},{message,{caller}}]}],
- ttb:tp(Mod,MS),
- ok.
-
-out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S)
- when W==webtool;W==mod_esi->
- io:format("~w: (~p)~ncall ~s~n", [TS,Pid,ffunc(MFA)]),
- [{M,F,length(A)}|S];
-out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) ->
- io:format("~w: (~p)~nreturned from ~s -> ~p~n", [TS,Pid,ffunc(MFA),R]),
- S;
-out(_,_,_,_) ->
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% Functions called via script. %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-script_start() ->
- usage(),
- halt().
-script_start([App]) ->
- DefaultBrowser =
- case os:type() of
- {win32,_} -> iexplore;
- _ -> firefox
- end,
- script_start([App,DefaultBrowser]);
-script_start([App,Browser]) ->
- io:format("Starting webtool...\n"),
- start(),
- AvailableApps = get_applications(),
- {OSType,_} = os:type(),
- case lists:keysearch(App,1,AvailableApps) of
- {value,{App,StartPage}} ->
- io:format("Starting ~w...\n",[App]),
- start_tools([],"app=" ++ atom_to_list(App)),
- PortStr = integer_to_list(get_port()),
- Url = case StartPage of
- "/" ++ Page ->
- "http://localhost:" ++ PortStr ++ "/" ++ Page;
- _ ->
- "http://localhost:" ++ PortStr ++ "/" ++ StartPage
- end,
- case Browser of
- none ->
- ok;
- iexplore when OSType == win32->
- io:format("Starting internet explorer...\n"),
- {ok,R} = win32reg:open(""),
- Key="\\local_machine\\SOFTWARE\\Microsoft\\IE Setup\\Setup",
- win32reg:change_key(R,Key),
- {ok,Val} = win32reg:value(R,"Path"),
- IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"),
- os:cmd("\"" ++ IExplore ++ "\" " ++ Url);
- _ when OSType == win32 ->
- io:format("Starting ~w...\n",[Browser]),
- os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url);
- B when B==firefox; B==mozilla ->
- io:format("Sending URL to ~w...",[Browser]),
- BStr = atom_to_list(Browser),
- SendCmd = BStr ++ " -raise -remote \'openUrl(" ++
- Url ++ ")\'",
- Port = open_port({spawn,SendCmd},[exit_status]),
- receive
- {Port,{exit_status,0}} ->
- io:format("done\n"),
- ok;
- {Port,{exit_status,_Error}} ->
- io:format(" not running, starting ~w...\n",
- [Browser]),
- os:cmd(BStr ++ " " ++ Url),
- ok
- after ?SEND_URL_TIMEOUT ->
- io:format(" failed, starting ~w...\n",[Browser]),
- erlang:port_close(Port),
- os:cmd(BStr ++ " " ++ Url)
- end;
- _ ->
- io:format("Starting ~w...\n",[Browser]),
- os:cmd(atom_to_list(Browser) ++ " " ++ Url)
- end,
- ok;
- false ->
- stop(),
- io:format("\n{error,{unknown_app,~p}}\n",[App]),
- halt()
- end.
-
-usage() ->
- io:format("Starting webtool...\n"),
- start(),
- Apps = lists:map(fun({A,_}) -> A end,get_applications()),
- io:format(
- "\nUsage: start_webtool application [ browser ]\n"
- "\nAvailable applications are: ~p\n"
- "Default browser is \'iexplore\' (Internet Explorer) on Windows "
- "or else \'firefox\'\n",
- [Apps]),
- stop().
-
-
-get_applications() ->
- gen_server:call(web_tool,get_applications).
-
-get_port() ->
- gen_server:call(web_tool,get_port).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% Api functions to the genserver. %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%----------------------------------------------------------------------
-%
-%----------------------------------------------------------------------
-
-start()->
- start(standard_path,standard_data).
-
-start(Path,standard_data)->
- case get_standard_data() of
- {error,Reason} ->
- {error,Reason};
- Data ->
- start(Path,Data)
- end;
-
-start(standard_path,Data)->
- Path=get_path(),
- start(Path,Data);
-
-start(Path,Port) when is_integer(Port)->
- Data = get_standard_data(Port),
- start(Path,Data);
-
-start(Path,Data0)->
- Data = Data0 ++ rest_of_standard_data(),
- gen_server:start({local,web_tool},webtool,{Path,Data},[]).
-
-stop()->
- gen_server:call(web_tool,stoppit).
-
-%----------------------------------------------------------------------
-%Web Api functions called by the web
-%----------------------------------------------------------------------
-started_tools(Env,Input)->
- gen_server:call(web_tool,{started_tools,Env,Input}).
-
-toolbar(Env,Input)->
- gen_server:call(web_tool,{toolbar,Env,Input}).
-
-start_tools(Env,Input)->
- gen_server:call(web_tool,{start_tools,Env,Input}).
-
-stop_tools(Env,Input)->
- gen_server:call(web_tool,{stop_tools,Env,Input}).
-%----------------------------------------------------------------------
-%Support API for other tools
-%----------------------------------------------------------------------
-
-is_localhost()->
- gen_server:call(web_tool,is_localhost).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%%The gen_server callback functions that builds the webbpages %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-handle_call(get_applications,_,State)->
- MS = ets:fun2ms(fun({Tool,{web_data,{_,Start}}}) -> {Tool,Start} end),
- Tools = ets:select(State#state.app_data,MS),
- {reply,Tools,State};
-
-handle_call(get_port,_,State)->
- {value,{port,Port}}=lists:keysearch(port,1,State#state.web_data),
- {reply,Port,State};
-
-handle_call({started_tools,_Env,_Input},_,State)->
- {reply,started_tools_page(State),State};
-
-handle_call({toolbar,_Env,_Input},_,State)->
- {reply,toolbar(),State};
-
-handle_call({start_tools,Env,Input},_,State)->
- {NewState,Page}=start_tools_page(Env,Input,State),
- {reply,Page,NewState};
-
-handle_call({stop_tools,Env,Input},_,State)->
- {NewState,Page}=stop_tools_page(Env,Input,State),
- {reply,Page,NewState};
-
-handle_call(stoppit,_From,Data)->
- {stop,normal,ok,Data};
-
-handle_call(is_localhost,_From,Data)->
- Result=case proplists:get_value(bind_address, Data#state.web_data) of
- ?DEFAULT_ADDR ->
- true;
- _IpNumber ->
- false
- end,
- {reply,Result,Data}.
-
-
-handle_info(_Message,State)->
- {noreply,State}.
-
-handle_cast(_Request,State)->
- {noreply,State}.
-
-code_change(_,State,_)->
- {ok,State}.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%
-% The other functions needed by the gen_server behaviour
-%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%----------------------------------------------------------------------
-% Start the gen_server
-%----------------------------------------------------------------------
-init({Path,Config})->
- case filelib:is_dir(Path) of
- true ->
- {ok, Table} = get_tool_files_data(),
- insert_app(?WEBTOOL_ALIAS, Table),
- case webtool_sup:start_link() of
- {ok, Pid} ->
- case start_webserver(Table, Path, Config) of
- {ok, _} ->
- print_url(Config),
- {ok,#state{priv_dir=Path,
- app_data=Table,
- supvis=Pid,
- web_data=Config}};
- {error, Error} ->
- {stop, {error, Error}}
- end;
- Error ->
- {stop,Error}
- end;
- false ->
- {stop, {error, error_dir}}
- end.
-
-terminate(_Reason,Data)->
- %%shut down the webbserver
- shutdown_server(Data),
- %%Shutdown the different tools that are started with application:start
- shutdown_apps(Data),
- %%Shutdown the supervisor and its children will die
- shutdown_supervisor(Data),
- ok.
-
-print_url(ConfigData)->
- Server=proplists:get_value(server_name,ConfigData,"undefined"),
- Port=proplists:get_value(port,ConfigData,"undefined"),
- {A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"),
- io:format("WebTool is available at http://~s:~w/~n",[Server,Port]),
- io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%
-% begin build the pages
-%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%----------------------------------------------------------------------
-%The page that shows the started tools
-%----------------------------------------------------------------------
-started_tools_page(State)->
- [?HEADER,?HTML_HEADER,started_tools(State),?HTML_END].
-
-toolbar()->
- [?HEADER,?HTML_HEADER,toolbar_page(),?HTML_END].
-
-
-start_tools_page(_Env,Input,State)->
- %%io:format("~n======= ~n ~p ~n============~n",[Input]),
- case get_tools(Input) of
- {tools,Tools}->
- %%io:format("~n======= ~n ~p ~n============~n",[Tools]),
- {ok,NewState}=handle_apps(Tools,State,start),
- {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(),
- show_unstarted_apps(NewState),?HTML_END]};
- _ ->
- {State,[?HEADER,?HTML_HEADER,show_unstarted_apps(State),?HTML_END]}
- end.
-
-stop_tools_page(_Env,Input,State)->
- case get_tools(Input) of
- {tools,Tools}->
- {ok,NewState}=handle_apps(Tools,State,stop),
- {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(),
- show_started_apps(NewState),?HTML_END]};
- _ ->
- {State,[?HEADER,?HTML_HEADER,show_started_apps(State),?HTML_END]}
- end.
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Functions that start and config the webserver
-%% 1. Collect the config data
-%% 2. Start webserver
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%----------------------------------------------------------------------
-% Start the webserver
-%----------------------------------------------------------------------
-start_webserver(Data,Path,Config)->
- case get_conf_data(Data,Path,Config) of
- {ok,Conf_data}->
- %%io:format("Conf_data: ~p~n",[Conf_data]),
- start_server(Conf_data);
- {error,Error} ->
- {error,{error_server_conf_file,Error}}
- end.
-
-start_server(Conf_data)->
- case inets:start(httpd, Conf_data, stand_alone) of
- {ok,Pid}->
- {ok,Pid};
- Error->
- {error,{server_error,Error}}
- end.
-
-%----------------------------------------------------------------------
-% Create config data for the webserver
-%----------------------------------------------------------------------
-get_conf_data(Data,Path,Config)->
- Aliases=get_aliases(Data),
- ServerRoot = filename:join([Path,"root"]),
- MimeTypesFile = filename:join([ServerRoot,"conf","mime.types"]),
- case httpd_conf:load_mime_types(MimeTypesFile) of
- {ok,MimeTypes} ->
- Config1 = Config ++ Aliases,
- Config2 = [{server_root,ServerRoot},
- {document_root,filename:join([Path,"root/doc"])},
- {mime_types,MimeTypes} |
- Config1],
- {ok,Config2};
- Error ->
- Error
- end.
-
-%----------------------------------------------------------------------
-% Control the path for *.tools files
-%----------------------------------------------------------------------
-get_tool_files_data()->
- Tools=get_tools1(code:get_path()),
- %%io:format("Data : ~p ~n",[Tools]),
- get_file_content(Tools).
-
-%----------------------------------------------------------------------
-%Control that the data in the file really is erlang terms
-%----------------------------------------------------------------------
-get_file_content(Tools)->
- Get_data=fun({tool,ToolData}) ->
- %%io:format("Data : ~p ~n",[ToolData]),
- case proplists:get_value(config_func,ToolData) of
- {M,F,A}->
- case catch apply(M,F,A) of
- {'EXIT',_} ->
- bad_data;
- Data when is_tuple(Data) ->
- Data;
- _->
- bad_data
- end;
- _ ->
- bad_data
- end
- end,
- insert_file_content([X ||X<-lists:map(Get_data,Tools),X/=bad_data]).
-
-%----------------------------------------------------------------------
-%Insert the data from the file in to the ets:table
-%----------------------------------------------------------------------
-insert_file_content(Content)->
- Table=ets:new(app_data,[bag]),
- lists:foreach(fun(X)->
- insert_app(X,Table)
- end,Content),
- {ok,Table}.
-
-%----------------------------------------------------------------------
-%Control that we got a a tuple of a atom and a list if so add the
-%elements in the list to the ets:table
-%----------------------------------------------------------------------
-insert_app({Name,Key_val_list},Table) when is_list(Key_val_list),is_atom(Name)->
- %%io:format("ToolData: ~p: ~p~n",[Name,Key_val_list]),
- lists:foreach(
- fun({alias,{erl_alias,Alias,Mods}}) ->
- Key_val = {erl_script_alias,{Alias,Mods}},
- %%io:format("Insert: ~p~n",[Key_val]),
- ets:insert(Table,{Name,Key_val});
- (Key_val_pair)->
- %%io:format("Insert: ~p~n",[Key_val_pair]),
- ets:insert(Table,{Name,Key_val_pair})
- end,
- Key_val_list);
-
-insert_app(_,_)->
- ok.
-
-%----------------------------------------------------------------------
-% Select all the alias in the database
-%----------------------------------------------------------------------
-get_aliases(Data)->
- MS = ets:fun2ms(fun({_,{erl_script_alias,Alias}}) ->
- {erl_script_alias,Alias};
- ({_,{alias,Alias}}) ->
- {alias,Alias}
- end),
- ets:select(Data,MS).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% Helper functions %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_standard_data(Port)->
- [
- {port,Port},
- {bind_address,?DEFAULT_ADDR},
- {server_name,"localhost"}
- ].
-
-get_standard_data()->
- case get_free_port(?DEFAULT_PORT,?MAX_NUMBER_OF_WEBTOOLS) of
- {error,Reason} -> {error,Reason};
- Port ->
- [
- {port,Port},
- {bind_address,?DEFAULT_ADDR},
- {server_name,"localhost"}
- ]
- end.
-
-get_free_port(_Port,0) ->
- {error,no_free_port_found};
-get_free_port(Port,N) ->
- case gen_tcp:connect("localhost",Port,[]) of
- {error, _Reason} ->
- Port;
- {ok,Sock} ->
- gen_tcp:close(Sock),
- get_free_port(Port+1,N-1)
- end.
-
-rest_of_standard_data() ->
- [
- %% Do not allow the server to be crashed by malformed http-request
- {max_header_siz,1024},
- {max_header_action,reply414},
- %% Go on a straight ip-socket
- {com_type,ip_comm},
- %% Do not change the order of these module names!!
- {modules,[mod_alias,
- mod_auth,
- mod_esi,
- mod_actions,
- mod_cgi,
- mod_include,
- mod_dir,
- mod_get,
- mod_head,
- mod_log,
- mod_disk_log]},
- {directory_index,["index.html"]},
- {default_type,"text/plain"}
- ].
-
-
-get_path()->
- code:priv_dir(webtool).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% These functions is used to shutdown the webserver
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%----------------------------------------------------------------------
-% Shut down the webbserver
-%----------------------------------------------------------------------
-shutdown_server(State)->
- {Addr,Port} = get_addr_and_port(State#state.web_data),
- inets:stop(httpd,{Addr,Port}).
-
-get_addr_and_port(Config) ->
- Addr = proplists:get_value(bind_address,Config,?DEFAULT_ADDR),
- Port = proplists:get_value(port,Config,?DEFAULT_PORT),
- {Addr,Port}.
-
-%----------------------------------------------------------------------
-% Select all apps in the table and close them
-%----------------------------------------------------------------------
-shutdown_apps(State)->
- Data=State#state.app_data,
- MS = ets:fun2ms(fun({_,{start,HowToStart}}) -> HowToStart end),
- lists:foreach(fun(Start_app)->
- stop_app(Start_app)
- end,
- ets:select(Data,MS)).
-
-%----------------------------------------------------------------------
-%Shuts down the supervisor that supervises tools that is not
-%Designed as applications
-%----------------------------------------------------------------------
-shutdown_supervisor(State)->
- %io:format("~n==================~n"),
- webtool_sup:stop(State#state.supvis).
- %io:format("~n==================~n").
-
-%----------------------------------------------------------------------
-%close the individual apps.
-%----------------------------------------------------------------------
-stop_app({child,_Real_name})->
- ok;
-
-stop_app({app,Real_name})->
- application:stop(Real_name);
-
-stop_app({func,_Start,Stop})->
- case Stop of
- {M,F,A} ->
- catch apply(M,F,A);
- _NoStop ->
- ok
- end.
-
-
-
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% These functions creates the webpage where the user can select if
-%% to start apps or to stop apps
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-toolbar_page()->
- "<TABLE>
- <TR>
- <TD>
- <B>Select Action</B>
- </TD>
- </TR>
- <TR>
- <TD>
- <A HREF=\"./start_tools\" TARGET=right> Start Tools</A>
- </TD>
- </TR>
- <TR>
- <TD>
- <A HREF=\"./stop_tools\" TARGET=right> Stop Tools</A>
- </TD>
- </TR>
- </TABLE>".
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% These functions creates the webbpage that shows the started apps
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%----------------------------------------------------------------------
-% started_tools(State)->String (html table)
-% State is a record of type state
-%----------------------------------------------------------------------
-started_tools(State)->
- Names=get_started_apps(State#state.app_data,State#state.started),
- "<TABLE BORDER=1 WIDTH=100%>
- "++ make_rows(Names,[],0) ++"
- </TABLE>".
-%----------------------------------------------------------------------
-%get_started_apps(Data,Started)-> [{web_name,link}]
-%selects the started apps from the ets table of apps.
-%----------------------------------------------------------------------
-
-get_started_apps(Data,Started)->
- SelectData=fun({Name,Link}) ->
- {Name,Link}
- end,
- MS = lists:map(fun(A) -> {{A,{web_data,'$1'}},[],['$1']} end,Started),
-
- [{"WebTool","/tool_management.html"} |
- [SelectData(X) || X <- ets:select(Data,MS)]].
-
-%----------------------------------------------------------------------
-% make_rows(List,Result,Fields)-> String (The rows of a htmltable
-% List a list of tupler discibed above
-% Result an accumulator for the result
-% Field, counter that counts the number of cols in each row.
-%----------------------------------------------------------------------
-make_rows([],Result,Fields)->
- Result ++ fill_out(Fields);
-make_rows([Data|Paths],Result,Field)when Field==0->
- make_rows(Paths,Result ++ "<TR>" ++ make_field(Data),Field+1);
-
-make_rows([Path|Paths],Result,Field)when Field==4->
- make_rows(Paths,Result ++ make_field(Path) ++ "</TR>",0);
-
-make_rows([Path|Paths],Result,Field)->
- make_rows(Paths,Result ++ make_field(Path),Field+1).
-
-%----------------------------------------------------------------------
-% make_fields(Path)-> String that is a field i a html table
-% Path is a name url tuple {Name,url}
-%----------------------------------------------------------------------
-make_field(Path)->
- "<TD WIDTH=20%>" ++ get_name(Path) ++ "</TD>".
-
-
-%----------------------------------------------------------------------
-%get_name({Nae,Url})->String that represents a <A> tag in html.
-%----------------------------------------------------------------------
-get_name({Name,Url})->
- "<A HREF=\"" ++ Url ++ "\" TARGET=app_frame>" ++ Name ++ "</A>".
-
-
-%----------------------------------------------------------------------
-% fill_out(Nr)-> String, that represent Nr fields in a html-table.
-%----------------------------------------------------------------------
-fill_out(Nr)when Nr==0->
- [];
-fill_out(Nr)when Nr==4->
- "<TD WIDTH=\"20%\" >&nbsp</TD></TR>";
-
-fill_out(Nr)->
- "<TD WIDTH=\"20%\">&nbsp</TD>" ++ fill_out(Nr+1).
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%%These functions starts applicatons and builds the page showing tools
-%%to start
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%----------------------------------------------------------------------
-%Controls whether the user selected a tool to start
-%----------------------------------------------------------------------
-get_tools(Input)->
- case httpd:parse_query(Input) of
- []->
- no_tools;
- Tools->
- FormatData=fun({_Name,Data}) -> list_to_atom(Data) end,
- SelectData=
- fun({Name,_Data}) -> string:equal(Name,"app") end,
- {tools,[FormatData(X)||X<-Tools,SelectData(X)]}
- end.
-
-%----------------------------------------------------------------------
-% Selects the data to start the applications the user has ordered
-% starting of
-%----------------------------------------------------------------------
-handle_apps([],State,_Cmd)->
- {ok,State};
-
-handle_apps([Tool|Tools],State,Cmd)->
- case ets:match_object(State#state.app_data,{Tool,{start,'_'}}) of
- []->
- Started = case Cmd of
- start ->
- [Tool|State#state.started];
- stop ->
- lists:delete(Tool,State#state.started)
- end,
- {ok,#state{priv_dir=State#state.priv_dir,
- app_data=State#state.app_data,
- supvis=State#state.supvis,
- web_data=State#state.web_data,
- started=Started}};
- ToStart ->
- case handle_apps2(ToStart,State,Cmd) of
- {ok,NewState}->
- handle_apps(Tools,NewState,Cmd);
- _->
- handle_apps(Tools,State,Cmd)
- end
- end.
-
-%----------------------------------------------------------------------
-%execute every start or stop data about a tool.
-%----------------------------------------------------------------------
-handle_apps2([{Name,Start_data}],State,Cmd)->
- case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd) of
- ok->
- Started = case Cmd of
- start ->
- [Name|State#state.started];
- stop ->
-
- lists:delete(Name,State#state.started)
- end,
- {ok,#state{priv_dir=State#state.priv_dir,
- app_data=State#state.app_data,
- supvis=State#state.supvis,
- web_data=State#state.web_data,
- started=Started}};
- _->
- error
- end;
-
-handle_apps2([{Name,Start_data}|Rest],State,Cmd)->
- case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd)of
- ok->
- handle_apps2(Rest,State,Cmd);
- _->
- error
- end.
-
-
-%----------------------------------------------------------------------
-% Handle start and stop of applications
-%----------------------------------------------------------------------
-
-handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)->
- Action = case Cmd of
- start ->
- Start;
- _ ->
- Stop
- end,
- case Action of
- {M,F,A} ->
- case catch apply(M,F,A) of
- {'EXIT',_} = Exit->
- %%! Here the tool disappears from the webtool interface!!
- io:format("\n=======ERROR (webtool, line ~w) =======\n"
- "Could not start application \'~p\'\n\n"
- "~w:~w(~s) ->\n"
- "~p\n\n",
- [?LINE,Name,M,F,format_args(A),Exit]),
- ets:delete(Data,Name);
- _OK->
- ok
- end;
- _NoStart ->
- ok
- end;
-
-
-handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)->
- case Cmd of
- start ->
- case catch supervisor:start_child(Pid,ChildSpec) of
- {ok,_}->
- ok;
- {ok,_,_}->
- ok;
- {error,Reason}->
- %%! Here the tool disappears from the webtool interface!!
- io:format("\n=======ERROR (webtool, line ~w) =======\n"
- "Could not start application \'~p\'\n\n"
- "supervisor:start_child(~p,~p) ->\n"
- "~p\n\n",
- [?LINE,Name,Pid,ChildSpec,{error,Reason}]),
- ets:delete(Data,Name);
- Error ->
- %%! Here the tool disappears from the webtool interface!!
- io:format("\n=======ERROR (webtool, line ~w) =======\n"
- "Could not start application \'~p\'\n\n"
- "supervisor:start_child(~p,~p) ->\n"
- "~p\n\n",
- [?LINE,Name,Pid,ChildSpec,Error]),
- ets:delete(Data,Name)
- end;
- stop ->
- case catch supervisor:terminate_child(websup,element(1,ChildSpec)) of
- ok ->
- supervisor:delete_child(websup,element(1,ChildSpec));
- _ ->
- error
- end
- end;
-
-
-
-handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)->
- case Cmd of
- start ->
- case application:start(Real_name,temporary) of
- ok->
- io:write(Name),
- ok;
- {error,{already_started,_}}->
- %% Remove it from the database so we dont start
- %% anything already started
- ets:match_delete(Data,{Name,{start,{app,Real_name}}}),
- ok;
- {error,_Reason}=Error->
- %%! Here the tool disappears from the webtool interface!!
- io:format("\n=======ERROR (webtool, line ~w) =======\n"
- "Could not start application \'~p\'\n\n"
- "application:start(~p,~p) ->\n"
- "~p\n\n",
- [?LINE,Name,Real_name,temporary,Error]),
- ets:delete(Data,Name)
- end;
-
- stop ->
- application:stop(Real_name)
- end;
-
-%----------------------------------------------------------------------
-% If the data is incorrect delete the app
-%----------------------------------------------------------------------
-handle_app({Name,Incorrect},Data,_Pid,Cmd)->
- %%! Here the tool disappears from the webtool interface!!
- io:format("\n=======ERROR (webtool, line ~w) =======\n"
- "Could not ~w application \'~p\'\n\n"
- "Incorrect data: ~p\n\n",
- [?LINE,Cmd,Name,Incorrect]),
- ets:delete(Data,Name).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% this functions creates the page that shows the unstarted tools %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-reload_started_apps()->
- "<script>
- function reloadCompiledList()
- {
- parent.parent.top1.document.location.href=\"/webtool/webtool/started_tools\";
- }
- </script>".
-
-show_unstarted_apps(State)->
- "<TABLE HEIGHT=100% WIDTH=100% BORDER=0>
- <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\">
- <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/start_tools\" >
- <TABLE BORDER=1 WIDTH=60%>
- <TR BGCOLOR=\"#8899AA\">
- <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Available Tools<FONT></TD>
- </TR>
- <TR>
- <TD WIDTH=50%>
- <TABLE BORDER=0>
- "++ list_available_apps(State)++"
- <TR><TD COLSPAN=2>&nbsp;</TD></TR>
- <TR>
- <TD COLSPAN=2 ALIGN=\"center\">
- <INPUT TYPE=submit VALUE=\"Start\">
- </TD>
- </TR>
- </TABLE>
- </TD>
- <TD>
- To Start a Tool:
- <UL>
- <LI>Select the
- checkbox for each tool to
- start.</LI>
- <LI>Click on the
- button marked <EM>Start</EM>.</LI></UL>
- </TD>
- </TR>
- </TABLE>
- </FORM>
- </TD></TR>
- <TR><TD>&nbsp;</TD></TR>
- </TABLE>".
-
-
-
-list_available_apps(State)->
- MS = ets:fun2ms(fun({Tool,{web_data,{Name,_}}}) -> {Tool,Name} end),
- Unstarted_apps=
- lists:filter(
- fun({Tool,_})->
- false==lists:member(Tool,State#state.started)
- end,
- ets:select(State#state.app_data,MS)),
- case Unstarted_apps of
- []->
- "<TR><TD>All tools are started</TD></TR>";
- _->
- list_apps(Unstarted_apps)
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% these functions creates the page that shows the started apps %%
-%% the user can select to shutdown %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-show_started_apps(State)->
- "<TABLE HEIGHT=100% WIDTH=100% BORDER=0>
- <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\">
- <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/stop_tools\" >
- <TABLE BORDER=1 WIDTH=60%>
- <TR BGCOLOR=\"#8899AA\">
- <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Started Tools<FONT></TD>
- </TR>
- <TR>
- <TD WIDTH=50%>
- <TABLE BORDER=0>
- "++ list_started_apps(State)++"
- <TR><TD COLSPAN=2>&nbsp;</TD></TR>
- <TR>
- <TD COLSPAN=2 ALIGN=\"center\">
- <INPUT TYPE=submit VALUE=\"Stop\">
- </TD>
- </TR>
- </TABLE>
- </TD>
- <TD>
- Stop a Tool:
- <UL>
- <LI>Select the
- checkbox for each tool to
- stop.</LI>
- <LI>Click on the
- button marked <EM>Stop</EM>.</LI></UL>
- </TD>
- </TR>
- </TABLE>
- </FORM>
- </TD></TR>
- <TR><TD>&nbsp;</TD></TR>
- </TABLE>".
-
-list_started_apps(State)->
- MS = lists:map(fun(A) -> {{A,{web_data,{'$1','_'}}},[],[{{A,'$1'}}]} end,
- State#state.started),
- Started_apps= ets:select(State#state.app_data,MS),
- case Started_apps of
- []->
- "<TR><TD>No tool is started yet.</TD></TR>";
- _->
- list_apps(Started_apps)
- end.
-
-
-list_apps(Apps) ->
- lists:map(fun({Tool,Name})->
- "<TR><TD>
- <INPUT TYPE=\"checkbox\" NAME=\"app\" VALUE=\""
- ++ atom_to_list(Tool) ++ "\">
- " ++ Name ++ "
- </TD></TR>"
- end,
- Apps).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% Collecting the data from the *.tool files %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%----------------------------------------
-% get_tools(Dirs) => [{M,F,A},{M,F,A}...{M,F,A}]
-% Dirs - [string()] Directory names
-% Calls get_tools2/2 recursively for a number of directories
-% to retireve the configuration data for the web based tools.
-%----------------------------------------
-get_tools1(Dirs)->
- get_tools1(Dirs,[]).
-
-get_tools1([Dir|Rest],Data) when is_list(Dir) ->
- Tools=case filename:basename(Dir) of
- %% Dir is an 'ebin' directory, check in '../priv' as well
- "ebin" ->
- [get_tools2(filename:join(filename:dirname(Dir),"priv")) |
- get_tools2(Dir)];
- _ ->
- get_tools2(Dir)
- end,
- get_tools1(Rest,[Tools|Data]);
-
-get_tools1([],Data) ->
- lists:flatten(Data).
-
-%----------------------------------------
-% get_tools2(Directory) => DataList
-% DataList : [WebTuple]|[]
-% WebTuple: {tool,[{web,M,F,A}]}
-%
-%----------------------------------------
-get_tools2(Dir)->
- get_tools2(tool_files(Dir),[]).
-
-get_tools2([ToolFile|Rest],Data) ->
- case get_tools3(ToolFile) of
- {tool,WebData} ->
- get_tools2(Rest,[{tool,WebData}|Data]);
- {error,_Reason} ->
- get_tools2(Rest,Data);
- nodata ->
- get_tools2(Rest,Data)
- end;
-
-get_tools2([],Data) ->
- Data.
-
-%----------------------------------------
-% get_tools3(ToolFile) => {ok,Tool}|{error,Reason}|nodata
-% Tool: {tool,[KeyValTuple]}
-% ToolFile - string() A .tool file
-% Now we have the file get the data and sort it out
-%----------------------------------------
-get_tools3(ToolFile) ->
- case file:consult(ToolFile) of
- {error,open} ->
- {error,nofile};
- {error,read} ->
- {error,format};
- {ok,[{version,"1.2"},ToolInfo]} when is_list(ToolInfo)->
- webdata(ToolInfo);
- {ok,[{version,_Vsn},_Info]} ->
- {error,old_version};
- {ok,_Other} ->
- {error,format}
- end.
-
-
-%----------------------------------------------------------------------
-% webdata(TupleList)-> ToolTuple| nodata
-% ToolTuple: {tool,[{config_func,{M,F,A}}]}
-%
-% There are a little unneccesary work in this format but it is extendable
-%----------------------------------------------------------------------
-webdata(TupleList)->
- case proplists:get_value(config_func,TupleList,nodata) of
- {M,F,A} ->
- {tool,[{config_func,{M,F,A}}]};
- _ ->
- nodata
- end.
-
-
-%=============================================================================
-% Functions for getting *.tool configuration files
-%=============================================================================
-
-%----------------------------------------
-% tool_files(Dir) => ToolFiles
-% Dir - string() Directory name
-% ToolFiles - [string()]
-% Return the list of all files in Dir ending with .tool (appended to Dir)
-%----------------------------------------
-tool_files(Dir) ->
- case file:list_dir(Dir) of
- {ok,Files} ->
- filter_tool_files(Dir,Files);
- {error,_Reason} ->
- []
- end.
-
-%----------------------------------------
-% filter_tool_files(Dir,Files) => ToolFiles
-% Dir - string() Directory name
-% Files, ToolFiles - [string()] File names
-% Filters out the files in Files ending with .tool and append them to Dir
-%----------------------------------------
-filter_tool_files(_Dir,[]) ->
- [];
-filter_tool_files(Dir,[File|Rest]) ->
- case filename:extension(File) of
- ".tool" ->
- [filename:join(Dir,File)|filter_tool_files(Dir,Rest)];
- _ ->
- filter_tool_files(Dir,Rest)
- end.
-
-
-%%%-----------------------------------------------------------------
-%%% format functions
-ffunc({M,F,A}) when is_list(A) ->
- io_lib:format("~w:~w(~s)\n",[M,F,format_args(A)]);
-ffunc({M,F,A}) when is_integer(A) ->
- io_lib:format("~w:~w/~w\n",[M,F,A]).
-
-format_args([]) ->
- "";
-format_args(Args) ->
- Str = lists:append(["~p"|lists:duplicate(length(Args)-1,",~p")]),
- io_lib:format(Str,Args).
diff --git a/lib/webtool/src/webtool_sup.erl b/lib/webtool/src/webtool_sup.erl
deleted file mode 100644
index e4a05c53ae..0000000000
--- a/lib/webtool/src/webtool_sup.erl
+++ /dev/null
@@ -1,75 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(webtool_sup).
-
--behaviour(supervisor).
-
-%% External exports
--export([start_link/0,stop/1]).
-
-%% supervisor callbacks
--export([init/1]).
-
-%%%----------------------------------------------------------------------
-%%% API
-%%%----------------------------------------------------------------------
-start_link() ->
- supervisor:start_link({local,websup},webtool_sup, []).
-
-stop(Pid)->
- exit(Pid,normal).
-%%%----------------------------------------------------------------------
-%%% Callback functions from supervisor
-%%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Func: init/1
-%% Returns: {ok, {SupFlags, [ChildSpec]}} |
-%% ignore |
-%% {error, Reason}
-%%----------------------------------------------------------------------
-init(_StartArgs) ->
- %%Child1 =
- %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]},
- %%{ok,{{simple_one_for_one,5,10},[Child1]}}.
- {ok,{{one_for_one,100,10},[]}}.
-
-%%%----------------------------------------------------------------------
-%%% Internal functions
-%%%----------------------------------------------------------------------
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/webtool/test/Makefile b/lib/webtool/test/Makefile
deleted file mode 100644
index 93aa1c09eb..0000000000
--- a/lib/webtool/test/Makefile
+++ /dev/null
@@ -1,65 +0,0 @@
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= \
- webtool_SUITE
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-INSTALL_PROGS= $(TARGET_FILES)
-
-EMAKEFILE=Emakefile
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/webtool_test
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-
-ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
-
-EBIN = .
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-make_emakefile:
- $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \
- > $(EMAKEFILE)
- $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \
- >> $(EMAKEFILE)
-
-tests debug opt: make_emakefile
- erl $(ERL_MAKE_FLAGS) -make
-
-clean:
- rm -f $(EMAKEFILE)
- rm -f $(TARGET_FILES) $(GEN_FILES)
- rm -f core
-
-docs:
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
-
-release_tests_spec: make_emakefile
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) webtool.spec "$(RELSYSDIR)"
- chmod -R u+w "$(RELSYSDIR)"
-
-release_docs_spec:
diff --git a/lib/webtool/test/webtool.spec b/lib/webtool/test/webtool.spec
deleted file mode 100644
index 134e6ed40c..0000000000
--- a/lib/webtool/test/webtool.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../webtool_test",all}.
diff --git a/lib/webtool/test/webtool_SUITE.erl b/lib/webtool/test/webtool_SUITE.erl
deleted file mode 100644
index 9e2d9a2e0f..0000000000
--- a/lib/webtool/test/webtool_SUITE.erl
+++ /dev/null
@@ -1,51 +0,0 @@
-%% ``Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT 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.''
-%%
--module(webtool_SUITE).
-
--compile([export_all]).
--include_lib("common_test/include/ct.hrl").
-
-suite() ->
- [{ct_hooks, [ts_install_cth]}].
-
-all() ->
- [app, appup].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-app() ->
- [{doc, "Test that the webtool app file is ok"}].
-app(Config) when is_list(Config) ->
- ok = ?t:app_test(webtool).
-
-appup() ->
- [{doc, "Test that the webtool appup file is ok"}].
-appup(Config) when is_list(Config) ->
- ok = ?t:appup_test(webtool).
diff --git a/lib/webtool/vsn.mk b/lib/webtool/vsn.mk
deleted file mode 100644
index 4a701ae6e0..0000000000
--- a/lib/webtool/vsn.mk
+++ /dev/null
@@ -1 +0,0 @@
-WEBTOOL_VSN=0.9
diff --git a/lib/wx/examples/demo/ex_canvas.erl b/lib/wx/examples/demo/ex_canvas.erl
index cdc783055c..acc94743d6 100644
--- a/lib/wx/examples/demo/ex_canvas.erl
+++ b/lib/wx/examples/demo/ex_canvas.erl
@@ -219,4 +219,4 @@ redraw(DC, Bitmap) ->
wxMemoryDC:destroy(MemoryDC).
get_pos(W,H) ->
- {random:uniform(W), random:uniform(H)}.
+ {rand:uniform(W), rand:uniform(H)}.
diff --git a/lib/wx/examples/sudoku/sudoku_game.erl b/lib/wx/examples/sudoku/sudoku_game.erl
index e3c39b4ec9..8bb5fe4d38 100644
--- a/lib/wx/examples/sudoku/sudoku_game.erl
+++ b/lib/wx/examples/sudoku/sudoku_game.erl
@@ -151,8 +151,7 @@ test() -> %% Known to solvable
{{9,2},4}, {{9,4},5}, {{9,6},8}, {{9,8},7}].
new_game(S) ->
- {X,Y,Z} = erlang:now(),
- random:seed(Y,X,Z),
+ rand:seed(exsplus),
case new_game(1,1,gb_sets:empty(),empty_table(S#s{}),[], 0) of
stop -> new_game(S);
Game -> Game
@@ -171,7 +170,7 @@ new_game(R,C,BT,St,Acc,Cnt) when R < 10, C < 10 ->
[{{BR,BC},BVal,BBT,BST}|BAcc] = Acc,
new_game(BR,BC,gb_sets:add(BVal,BBT),BST,BAcc,Cnt+1);
Size ->
- Ind = random:uniform(Size),
+ Ind = rand:uniform(Size),
V = lists:nth(Ind,gb_sets:to_list(S)),
new_game(R,C+1,gb_sets:empty(),
add({R,C,M},V,St),
@@ -207,7 +206,7 @@ pick_shown(Given,Left,S0,Level,Gfx) ->
io:format("Below level ~p ~p~n", [GivenSz,Level]),
S0;
true ->
- Ran = random:uniform(LeftSz),
+ Ran = rand:uniform(LeftSz),
V = lists:nth(Ran,gb_sets:to_list(Left)),
S1 = rebuild_all(rcm(V),S0#s{v=setelement(V,S0#s.v,0)}),
case solve(S1, true) of
diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile
index f9c03336c8..14e11d5fc4 100644
--- a/lib/xmerl/test/Makefile
+++ b/lib/xmerl/test/Makefile
@@ -84,7 +84,7 @@ RELSYSDIR = $(RELEASE_PATH)/xmerl_test
# FLAGS
# ----------------------------------------------------
-#ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include -I$(ERL_TOP)/lib/xmerl/include/ $(XMERL_PRESERV_TEST_DIRS)
+ERL_COMPILE_FLAGS +=
# ----------------------------------------------------
diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl
index 7ddf1066de..672f8a43d1 100644
--- a/lib/xmerl/test/xmerl_SUITE.erl
+++ b/lib/xmerl/test/xmerl_SUITE.erl
@@ -27,7 +27,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%-include("xmerl.hrl").
-include_lib("xmerl/include/xmerl.hrl").
-include_lib("kernel/include/file.hrl").
diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl
index afd39b6598..2e026d7476 100644
--- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl
+++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl
@@ -10,7 +10,7 @@
-export([test/0, check_node_set/2, ticket_6873/0, ticket_7496/0, functions/0]).
-export([namespaces/0]).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("xmerl/include/xmerl.hrl").
test() ->
diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl
index 4cde46826e..f5c65b0c63 100644
--- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl
+++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl
@@ -9,7 +9,7 @@
-export([test/0,check_node_set/2,ticket_6873/0]).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("xmerl/include/xmerl.hrl").
test() ->
diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl
index e39ad6bcb0..c3a1fb9c4d 100644
--- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl
+++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl
@@ -9,7 +9,7 @@
-compile(export_all).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("xmerl/include/xmerl.hrl").
-import(xmerl_xs,
diff --git a/lib/xmerl/test/xmerl_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl
index a15d9bd57c..f0e80f81d3 100644
--- a/lib/xmerl/test/xmerl_sax_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_SUITE.erl
@@ -27,7 +27,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
%%======================================================================
diff --git a/lib/xmerl/test/xmerl_sax_std_SUITE.erl b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
index 70e768ff04..b820bd5bc2 100644
--- a/lib/xmerl/test/xmerl_sax_std_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
@@ -27,7 +27,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
%%======================================================================
diff --git a/lib/xmerl/test/xmerl_std_SUITE.erl b/lib/xmerl/test/xmerl_std_SUITE.erl
index 0ef44bb04e..d3e28353e2 100644
--- a/lib/xmerl/test/xmerl_std_SUITE.erl
+++ b/lib/xmerl/test/xmerl_std_SUITE.erl
@@ -25,7 +25,7 @@
%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%-include("xmerl.hrl").
-include_lib("xmerl/include/xmerl.hrl").
diff --git a/lib/xmerl/test/xmerl_test_lib.erl b/lib/xmerl/test/xmerl_test_lib.erl
index 62689353f2..aa8a86138a 100644
--- a/lib/xmerl/test/xmerl_test_lib.erl
+++ b/lib/xmerl/test/xmerl_test_lib.erl
@@ -28,7 +28,7 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("xmerl/include/xmerl.hrl").
%% cmp_element/2
diff --git a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl
index ee648dc455..7393a878e2 100644
--- a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl
+++ b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl
@@ -27,7 +27,7 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("xmerl/include/xmerl.hrl").
-include_lib("xmerl/include/xmerl_xsd.hrl").
diff --git a/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl
index 634e47ba7b..6a645b255e 100644
--- a/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl
+++ b/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl
@@ -27,7 +27,7 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("xmerl/include/xmerl.hrl").
-include_lib("xmerl/include/xmerl_xsd.hrl").
diff --git a/lib/xmerl/test/xmerl_xsd_SUITE.erl b/lib/xmerl/test/xmerl_xsd_SUITE.erl
index 92c8287782..e1ce8525c7 100644
--- a/lib/xmerl/test/xmerl_xsd_SUITE.erl
+++ b/lib/xmerl/test/xmerl_xsd_SUITE.erl
@@ -25,7 +25,7 @@
-compile(export_all).
%%-export([Function/Arity, ...]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%-include("xmerl.hrl").
-include_lib("xmerl/include/xmerl.hrl").
diff --git a/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl
index 5ad6bb94fb..5057e70956 100644
--- a/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl
+++ b/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl
@@ -27,7 +27,7 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("xmerl/include/xmerl.hrl").
-include_lib("xmerl/include/xmerl_xsd.hrl").
diff --git a/lib/xmerl/test/xmerl_xsd_lib.erl b/lib/xmerl/test/xmerl_xsd_lib.erl
index 892706609f..58fb6a27cc 100644
--- a/lib/xmerl/test/xmerl_xsd_lib.erl
+++ b/lib/xmerl/test/xmerl_xsd_lib.erl
@@ -32,7 +32,7 @@
-compile(export_all).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include("xmerl.hrl").
-include("xmerl_xsd.hrl").
-include_lib("kernel/include/file.hrl").
diff --git a/make/ose_lm.mk.in b/make/ose_lm.mk.in
deleted file mode 100644
index de8d351af3..0000000000
--- a/make/ose_lm.mk.in
+++ /dev/null
@@ -1,76 +0,0 @@
-#-*-makefile-*- ; force emacs to enter makefile-mode
-# ----------------------------------------------------
-# Template target for generating an OSE5 load module
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2013. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-# Author: Petre Pircalabu
-# ----------------------------------------------------
-
-# ----------------------------------------------------
-# build-ose-load-module
-# Creates an OSE5 load module
-# params:
-# $(1) - The output target
-# $(2) - Objects
-# $(3) - Libraries
-# $(4) - LM configuration file
-# ----------------------------------------------------
-
-ifeq ($(findstring ose,$(TARGET)),ose)
-LDR1FLAGS = @erl_xcomp_ose_ldflags_pass1@
-LDR2FLAGS = @erl_xcomp_ose_ldflags_pass2@
-OSEROOT = @erl_xcomp_ose_OSEROOT@
-LCF = @erl_xcomp_ose_LM_LCF@
-BEAM_LMCONF = @erl_xcomp_ose_BEAM_LM_CONF@
-EPMD_LMCONF = @erl_xcomp_ose_EPMD_LM_CONF@
-RUN_ERL_LMCONF = @erl_xcomp_ose_RUN_ERL_LM_CONF@
-STRIP = @erl_xcomp_ose_STRIP@
-LM_POST_LINK = @erl_xcomp_ose_LM_POST_LINK@
-LM_SET_CONF = @erl_xcomp_ose_LM_SET_CONF@
-LM_ELF_SIZE = @erl_xcomp_ose_LM_ELF_SIZE@
-OSE_CONFD = @erl_xcomp_ose_CONFD@
-CRT0_LM = @erl_xcomp_ose_CRT0_LM@
-endif
-
-define build-ose-load-module
- @echo " --- Linking $(1)"
-
- @echo " --- Linking $(1) (pass 1)"
- $(ld_verbose)$(PURIFY) $(LD) -o $(1)_unconfigured_ro -r \
- $(2) --start-group $(3) --end-group --cref --discard-none -M > $(1)_1.map
-
- @echo " --- Linking $(1) (pass 2)"
- $(ld_verbose)$(PURIFY) $(LD) -o $(1)_unconfigured \
- $(1)_unconfigured_ro -T $(LCF) -n --emit-relocs -e crt0_lm --cref \
- --discard-none -M > $(1)_2.map
-
- @echo " --- Inserting configuration"
- $(ld_verbose) $(LM_SET_CONF) $(1)_unconfigured < $(4)
-
- @echo " --- Striping $(1)"
-# $(ld_verbose) $(STRIP) $(1)_unconfigured
-
- @echo " --- Postlinking $(1)"
- $(ld_verbose) $(LM_POST_LINK) $(1)_unconfigured
-
- @echo " --- Sizing $(1)"
- $(ld_verbose) $(LM_ELF_SIZE) $(1)_unconfigured
- mv $(1)_unconfigured $(1)
-endef
diff --git a/make/otp.mk.in b/make/otp.mk.in
index 723f83cb45..c05c499d66 100644
--- a/make/otp.mk.in
+++ b/make/otp.mk.in
@@ -90,14 +90,10 @@ OTP_RELEASE = @OTP_RELEASE@
# Erlang language section
# ----------------------------------------------------
EMULATOR = beam
-ifeq ($(findstring ose_ppc750,$(TARGET)),ose_ppc750)
-ERL_COMPILE_FLAGS += +compressed
+ifdef BOOTSTRAP
+ ERL_COMPILE_FLAGS += +slim
else
- ifdef BOOTSTRAP
- ERL_COMPILE_FLAGS += +slim
- else
- ERL_COMPILE_FLAGS += +debug_info
- endif
+ ERL_COMPILE_FLAGS += +debug_info
endif
ERLC_WFLAGS = -W
ERLC = erlc $(ERLC_WFLAGS) $(ERLC_FLAGS)
diff --git a/otp_build b/otp_build
index ac99ced42a..57dc2e3a9c 100755
--- a/otp_build
+++ b/otp_build
@@ -26,7 +26,7 @@ EXPECTED_AUTOCONF_VERSION=2.59
#
# NOTE: lazy_configure depends on '.' always being last directory
if [ -z "$ONLY_ERTS" ]; then
- AUTOCONF_SUBDIRS="lib lib/* lib/test_server/src"
+ AUTOCONF_SUBDIRS="lib lib/* lib/common_test/test_server"
fi
AUTOCONF_SUBDIRS="$AUTOCONF_SUBDIRS erts ."
@@ -264,7 +264,7 @@ create_lib_configure_in()
distribute_config_helpers ()
{
aclocal_dirs=". ./lib/erl_interface ./lib/odbc ./lib/wx ./lib/megaco"
- autoconf_aux_dirs="./lib/common_test/priv/auxdir ./lib/erl_interface/src/auxdir ./lib/test_server/src ./lib/wx/autoconf"
+ autoconf_aux_dirs="./lib/common_test/priv/auxdir ./lib/erl_interface/src/auxdir ./lib/common_test/test_server ./lib/wx/autoconf"
aclocal_master="./erts/aclocal.m4"
install_sh_master="./erts/autoconf/install-sh"
diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml
index 893398b71b..e98fcbcbb9 100644
--- a/system/doc/reference_manual/expressions.xml
+++ b/system/doc/reference_manual/expressions.xml
@@ -245,13 +245,13 @@ lists:keysearch(Name, 1, List)</code>
handle(Msg, State)
spawn(m, init, [])</code>
<p><em>Examples</em> where <c>ExprF</c> is a fun:</p>
- <code type="none">
-Fun1 = fun(X) -> X+1 end
-Fun1(3)
-=> 4
-
-fun lists:append/2([1,2], [3,4])
-=> [1,2,3,4]</code>
+ <pre>
+1> <input>Fun1 = fun(X) -> X+1 end,</input>
+<input>Fun1(3).</input>
+4
+2> <input>fun lists:append/2([1,2], [3,4]).</input>
+[1,2,3,4]
+3> </pre>
<p>Notice that when calling a local function, there is a difference
between using the implicitly or fully qualified function name.
@@ -1004,7 +1004,7 @@ M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.</code>
</p>
<list>
<item><p>A <c>badmatch</c> exception.</p>
- <p>This is if it is used in the context of the matching operator
+ <p>This is if it is used in the context of the match operator
as in the example.</p>
</item>
<item><p>Or resulting in the next clause being tested in function heads and
@@ -1085,7 +1085,7 @@ Ei = Value |
<p>Used in a bit string construction, <c>Value</c> is an expression
that is to evaluate to an integer, float, or bit string. If the
expression is not a single literal or variable, it
- is to be enclosed in parenthesis.</p>
+ is to be enclosed in parentheses.</p>
<p>Used in a bit string matching, <c>Value</c> must be a variable,
or an integer, float, or string.</p>
@@ -1319,7 +1319,7 @@ catch Expr</code>
{'EXIT',{badarith,[...]}}</pre>
<p>Notice that <c>catch</c> has low precedence and catch
subexpressions often needs to be enclosed in a block
- expression or in parenthesis:</p>
+ expression or in parentheses:</p>
<pre>
3> <input>A = catch 1+2.</input>
** 1: syntax error before: 'catch' **
diff --git a/system/doc/reference_manual/macros.xml b/system/doc/reference_manual/macros.xml
index 3b1f72e5d6..42ea639b54 100644
--- a/system/doc/reference_manual/macros.xml
+++ b/system/doc/reference_manual/macros.xml
@@ -146,6 +146,10 @@ bar(X) ->
<item>The current line number.</item>
<tag><c>?MACHINE</c>.</tag>
<item>The machine name, <c>'BEAM'</c>.</item>
+ <tag><c>?FUNCTION_NAME</c></tag>
+ <item>The name of the current function.</item>
+ <tag><c>?FUNCTION_ARITY</c></tag>
+ <item>The arity (number of arguments) for the current function.</item>
</taglist>
</section>
diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml
index 22627058c1..8915302088 100644
--- a/system/doc/reference_manual/typespec.xml
+++ b/system/doc/reference_manual/typespec.xml
@@ -69,7 +69,7 @@
<p>
For integers and atoms, it is allowed for singleton types; for example,
the integers
- <c>-1</c> and <c>42</c>, or the atoms <c>'foo'</c> and <c>'bar'</c>).
+ <c>-1</c> and <c>42</c>, or the atoms <c>'foo'</c> and <c>'bar'</c>.
All other types are built using unions of either predefined
types or singleton types. In a type union between a type and one
@@ -495,7 +495,8 @@
</p>
<pre> -spec id(X) -> X when X :: tuple().</pre>
<p>
- Currently, the <c>::</c> constraint (read as <c>is_subtype</c>) is
+ Currently, the <c>::</c> constraint
+ (read as &laquo;is a subtype of&raquo;) is
the only guard constraint that can be used in the <c>'when'</c>
part of a <c>'-spec'</c> attribute.
</p>
@@ -529,16 +530,6 @@
<pre>
-spec foo({X, integer()}) -> X when X :: atom()
; ([Y]) -> Y when Y :: number().</pre>
- <note>
- <p>
- For backwards compatibility the following form is also allowed:
- </p>
- <pre> -spec id(X) -> X when is_subtype(X, tuple()).</pre>
- <p>
- but its use is discouraged. It will be removed in a future
- Erlang/OTP release.
- </p>
- </note>
<p>
Some functions in Erlang are not meant to return;
either because they define servers or because they are used to
diff --git a/xcomp/erl-xcomp-powerpc-ose5.conf b/xcomp/erl-xcomp-powerpc-ose5.conf
deleted file mode 100644
index 88b2135593..0000000000
--- a/xcomp/erl-xcomp-powerpc-ose5.conf
+++ /dev/null
@@ -1,358 +0,0 @@
-## -*-shell-script-*-
-##
-## %CopyrightBegin%
-##
-## Copyright Ericsson AB 2009-2012. All Rights Reserved.
-##
-## Licensed under the Apache License, Version 2.0 (the "License");
-## you may not use this file except in compliance with the License.
-## You may obtain a copy of the License at
-##
-## http://www.apache.org/licenses/LICENSE-2.0
-##
-## Unless required by applicable law or agreed to in writing, software
-## distributed under the License is distributed on an "AS IS" BASIS,
-## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-## See the License for the specific language governing permissions and
-## limitations under the License.
-##
-## %CopyrightEnd%
-##
-## File: erl-xcomp-sfk-linux-ose5.conf
-## Author: Petre Pircalabu
-##
-## -----------------------------------------------------------------------------
-## When cross compiling Erlang/OTP using `otp_build', copy this file and set
-## the variables needed below. Then pass the path to the copy of this file as
-## an argument to `otp_build' in the configure stage:
-## `otp_build configure --xcomp-conf=<FILE>'
-## -----------------------------------------------------------------------------
-
-## Note that you cannot define arbitrary variables in a cross compilation
-## configuration file. Only the ones listed below will be guaranteed to be
-## visible throughout the whole execution of all `configure' scripts. Other
-## variables needs to be defined as arguments to `configure' or exported in
-## the environment.
-
-## -- Variables needed for an OSE5 build ---------------------------------------
-OSEROOT="/vobs/ose5/system"
-HOST="linux"
-
-GCCVERSION="4.4.3"
-GCCROOT="${OSEROOT}/gcc_linux_powerpc_${GCCVERSION}"
-
-OSEDEBUG="no"
-OSESSL="no"
-
-case ${GCCVERSION} in
-4.4.3)
- GCCTARGET="powerpc-eabi"
- ;;
-4.6.3)
- GCCTARGET="powerpc-ose-eabi"
- ;;
-*)
- echo "Error: Unknown GCCVERSION: ${GCCVERSION}"
- exit 1
-esac
-
-if [ ${OSEDEBUG} != "yes" ];
-then
-OPT_LEVEL="-O2"
-else
-OPT_LEVEL=""
-fi
-
-if [ ${OSESSL} = "yes" ];
-then
-## If your crypto is not in OSEROOT then you have to use --with-ssl to
-## point to the correct place. Also CRYPTO_LIB_PATH has to be modified to
-## point there as well.
-CRYPTO_CONFIG_OPTION="--disable-dynamic-ssl-lib"
-CRYPTO_NIF_PATH=",$ERL_TOP/lib/crypto/priv/lib/powerpc-unknown-ose/crypto.a"
-CRYPTO_LIB_PATH="${OSEROOT}/lib/powerpc/libsslcrypto.a"
-else
-CRYPTO_CONFIG_OPTION="--without-ssl"
-CRYPTO_NIF_PATH=""
-CRYPTO_LIB_PATH=""
-fi
-
-
-## -- Variables for `otp_build' Only -------------------------------------------
-
-## Variables in this section are only used, when configuring Erlang/OTP for
-## cross compilation using `$ERL_TOP/otp_build configure'.
-
-## *NOTE*! These variables currently have *no* effect if you configure using
-## the `configure' script directly.
-
-# * `erl_xcomp_build' - The build system used. This value will be passed as
-# `--build=$erl_xcomp_build' argument to the `configure' script. It does
-# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full
-# `CPU-VENDOR-OS' triplet will be created by
-# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess',
-# the build system will be guessed using
-# `$ERL_TOP/erts/autoconf/config.guess'.
-erl_xcomp_build=guess
-
-# * `erl_xcomp_host' - Cross host/target system to build for. This value will
-# be passed as `--host=$erl_xcomp_host' argument to the `configure' script.
-# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The
-# full `CPU-VENDOR-OS' triplet will be created by
-# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'.
-erl_xcomp_host="powerpc-ose"
-
-disabled_apps="--without-erl_interface --without-os_mon --without-megaco --without-observer --without-wx --without-appmon --without-cosEvent --without-cosEventDomain --without-cosFileTransfer --without-cosNotification --without-cosProperty --without-cosTime --without-cosTransactions --without-debugger --without-dialyzer --without-edoc --without-erl_docgen --without-eunit --without-gs --without-hipe --without-ic --without-orber --without-pman --without-toolbar --without-tv --without-webtool --without-typer"
-
-# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the
-# `configure' script.
-erl_xcomp_configure_flags="${CRYPTO_CONFIG_OPTION} --disable-kernel-poll --disable-hipe --without-termcap --without-javac ${disabled_apps} --enable-static-nifs=$ERL_TOP/lib/asn1/priv/lib/powerpc-unknown-ose/asn1rt_nif.a${CRYPTO_NIF_PATH}"
-
-## -- Cross Compiler and Other Tools -------------------------------------------
-
-## If the cross compilation tools are prefixed by `<HOST>-' you probably do
-## not need to set these variables (where `<HOST>' is what has been passed as
-## `--host=<HOST>' argument to `configure').
-
-## All variables in this section can also be used when native compiling.
-
-# * `CC' - C compiler.
-CC="$GCCROOT/bin/$GCCTARGET-gcc"
-
-# * `CFLAGS' - C compiler flags.
-CFLAGS="-msoft-float -g -fno-strict-aliasing -fno-builtin -fshort-wchar -Wall -Wno-unknown-pragmas -mpowerpc -nostdlib -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/ose_spi -I$OSEROOT/include/gcc -MD -MP -D__OSE__ -DBIG_ENDIAN -DCF_CONF_SIZE=0x800 ${OPT_LEVEL}"
-
-
-# * `STATIC_CFLAGS' - Static C compiler flags.
-#STATIC_CFLAGS=
-
-# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library
-# search path for the shared libraries. Note that this actually is a
-# linker flag, but it needs to be passed via the compiler.
-#CFLAG_RUNTIME_LIBRARY_PATH=
-
-# * `CPP' - C pre-processor.
-CPP="$GCCROOT/bin/$GCCTARGET-cpp"
-
-# * `CPPFLAGS' - C pre-processor flags.
-CPPFLAGS="-msoft-float -g -fno-strict-aliasing -fno-builtin -fshort-wchar -Wall -Wno-unknown-pragmas -mpowerpc -nostdlib -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/ose_spi -I$OSEROOT/include/gcc -MD -MP -D__OSE__ -DBIG_ENDIAN -DCF_CONF_SIZE=0x800 ${OPT_LEVEL}"
-
-
-# * `CXX' - C++ compiler.
-CXX="$GCCROOT/bin/$GCCTARGET-g++"
-
-# * `CXXFLAGS' - C++ compiler flags.
-CXXFLAGS="-msoft-float -g -fno-strict-aliasing -ansi -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/gcc ${OPT_LEVEL}"
-
-# * `LD' - Linker.
-LD="${GCCROOT}/bin/${GCCTARGET}-ld"
-
-# * `LDFLAGS' - Linker flags.
-LDFLAGS="-Wl,-ecrt0_lm -Wl,-T,${ERL_TOP}/erts/emulator/sys/ose/gcc_${GCCVERSION}_lm_ppc.lcf"
-
-# * `LIBS' - Libraries.
-LIBS="${OSEROOT}/lib/powerpc/libcrt.a ${OSEROOT}/lib/powerpc/libm.a ${GCCROOT}/lib/gcc/${GCCTARGET}/${GCCVERSION}/nof/libgcc.a ${CRYPTO_LIB_PATH}"
-
-## -- *D*ynamic *E*rlang *D*river Linking --
-
-## *NOTE*! Either set all or none of the `DED_LD*' variables.
-
-# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers.
-DED_LD=
-
-# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'.
-DED_LDFLAGS=
-
-# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library
-# search path for shared libraries when linking with `DED_LD'.
-DED_LD_FLAG_RUNTIME_LIBRARY_PATH=
-
-## -- Large File Support --
-
-## *NOTE*! Either set all or none of the `LFS_*' variables.
-
-# * `LFS_CFLAGS' - Large file support C compiler flags.
-#LFS_CFLAGS=
-
-# * `LFS_LDFLAGS' - Large file support linker flags.
-#LFS_LDFLAGS=
-
-# * `LFS_LIBS' - Large file support libraries.
-#LFS_LIBS=
-
-## -- Other Tools --
-
-# * `RANLIB' - `ranlib' archive index tool.
-RANLIB="$GCCROOT/bin/$GCCTARGET-ranlib"
-
-# * `AR' - `ar' archiving tool.
-AR="$GCCROOT/bin/$GCCTARGET-ar"
-
-# * `STRIP' - `strip
-STRIP="$GCCROOT/bin/$GCCTARGET-strip"
-
-# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is
-# currently used for finding out large file support flags to use, and
-# on Linux systems for finding out if we have an NPTL thread library or
-# not.
-#GETCONF=
-
-## -- Cross System Root Locations ----------------------------------------------
-
-# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross
-# compilation environment. Currently, the `crypto', `odbc', `ssh' and
-# `ssl' applications need the system root. These applications will be
-# skipped if the system root has not been set. The system root might be
-# needed for other things too. If this is the case and the system root
-# has not been set, `configure' will fail and request you to set it.
-erl_xcomp_sysroot="$OSEROOT"
-
-# * `erl_xcomp_isysroot' - The absolute path to the system root for includes
-# of the cross compilation environment. If not set, this value defaults
-# to `$erl_xcomp_sysroot', i.e., only set this value if the include system
-# root path is not the same as the system root path.
-#erl_xcomp_isysroot="$OSEROOT"
-
-## -- Optional Feature, and Bug Tests ------------------------------------------
-
-## These tests cannot (always) be done automatically when cross compiling. You
-## usually do not need to set these variables. Only set these if you really
-## know what you are doing.
-
-## Note that some of these values will override results of tests performed
-## by `configure', and some will not be used until `configure' is sure that
-## it cannot figure the result out.
-
-## The `configure' script will issue a warning when a default value is used.
-## When a variable has been set, no warning will be issued.
-
-# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes',
-# the target system must have a working `__after_morecore_hook' that can be
-# used for tracking used `malloc()' implementations core memory usage.
-# This is currently only used by unsupported features.
-#erl_xcomp_after_morecore_hook=
-
-# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system
-# must be big endian. If `no', little endian. This can often be
-# automatically detected, but not always. If not automatically detected,
-# `configure' will fail unless this variable is set. Since no default
-# value is used, `configure' will try to figure this out automatically.
-#erl_xcomp_bigendian=
-
-# * `erl_xcomp_double_middle` - `yes|no`. No default. If `yes`, the
-# target system must have doubles in "middle-endian" format. If
-# `no`, it has "regular" endianness. This can often be automatically
-# detected, but not always. If not automatically detected,
-# `configure` will fail unless this variable is set. Since no
-# default value is used, `configure` will try to figure this out
-# automatically.
-#erl_xcomp_double_middle_endian
-
-# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes',
-# the target system must have a working `clock_gettime()' implementation
-# that can be used for retrieving process CPU time.
-#erl_xcomp_clock_gettime_cpu_time=
-
-# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target
-# system must have a working `getaddrinfo()' implementation that can
-# handle both IPv4 and IPv6.
-#erl_xcomp_getaddrinfo=
-
-# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes',
-# the target system must have a working `gethrvtime()' implementation and
-# is used with procfs `ioctl()'.
-#erl_xcomp_gethrvtime_procfs_ioctl=
-
-# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the
-# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation
-# that can be used on `brk' and `sbrk' symbols used by the `malloc()'
-# implementation in use, and by this track the `malloc()' implementations
-# core memory usage. This is currently only used by unsupported features.
-#erl_xcomp_dlsym_brk_wrappers=
-
-# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target
-# system must have a working `kqueue()' implementation that returns a file
-# descriptor which can be used by `poll()' and/or `select()'. If `no' and
-# the target system has not got `epoll()' or `/dev/poll', the kernel-poll
-# feature will be disabled.
-#erl_xcomp_kqueue=
-
-# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on
-# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on
-# the target system must work. This variable is recommended to be set to
-# `no' on Linux systems with kernel versions less than 2.6.
-#erl_xcomp_linux_clock_gettime_correction=
-
-# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise,
-# `no'. If `yes', the target system must have NPTL (Native POSIX Thread
-# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux
-# kernel versions typically less than 2.6).
-#erl_xcomp_linux_nptl=
-
-# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux;
-# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target
-# system. `sigaltstack()' on Linux kernel versions less than 2.4 are
-# broken.
-#erl_xcomp_linux_usable_sigaltstack=
-
-# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes',
-# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old
-# LinuxThreads thread libraries (Linux kernel versions typically less than
-# 2.2) used these signals and made them unusable by the ERTS.
-#erl_xcomp_linux_usable_sigusrx=
-
-# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise,
-# `yes'. If `yes', the target system must have a working `poll()'
-# implementation that also can handle devices. If `no', `select()' will be
-# used instead of `poll()'.
-erl_xcomp_poll=no
-
-# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target
-# system must have a `putenv()' implementation that stores a copy of the
-# key/value pair.
-#erl_xcomp_putenv_copy=
-
-# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target
-# system must have reliable floating point exceptions.
-#erl_xcomp_reliable_fpe=
-# * `erl_xcomp_ose_ldflags_pass1` - Linker flags for the OSE module (pass 1)
-erl_xcomp_ose_ldflags_pass1="-r --no-omagic"
-
-# * `erl_xcomp_ose_ldflags_pass2` - Linker flags for the OSE module (pass 2)
-erl_xcomp_ose_ldflags_pass2="-n --emit-relocs -ecrt0_lm --no-omagic"
-
-# * `erl_xcomp_ose_OSEROOT` - OSE installation root directory
-erl_xcomp_ose_OSEROOT="${OSEROOT}"
-
-# * `erl_xcomp_ose_STRIP` - Strip utility shipped with the OSE distribution
-erl_xcomp_ose_STRIP="${GCCROOT}/bin/${GCCTARGET}-strip"
-
-# * `erl_xcomp_ose_LM_POST_LINK` - OSE postlink tool
-erl_xcomp_ose_LM_POST_LINK="${OSEROOT}/bin/${HOST}/lm_post_link"
-
-# * `erl_xcomp_ose_LM_SET_CONF` - Sets the configuration for an OSE load module
-erl_xcomp_ose_LM_SET_CONF="${OSEROOT}/bin/${HOST}/lm_set_conf"
-
-# * `erl_xcomp_ose_LM_ELF_SIZE` - OSE load module elf size tool
-erl_xcomp_ose_LM_ELF_SIZE="${OSEROOT}/bin/${HOST}/lm_elf_size"
-
-# * `erl_xcomp_ose_LM_LCF` - OSE load module linker configuration file
-erl_xcomp_ose_LM_LCF="${ERL_TOP}/erts/emulator/sys/ose/gcc_${GCCVERSION}_lm_ppc.lcf"
-
-# * `erl_xcomp_ose_BEAM_LM_CONF` - beam OSE load module configuration file
-erl_xcomp_ose_BEAM_LM_CONF="${ERL_TOP}/erts/emulator/sys/ose/beam.lmconf"
-
-# * `erl_xcomp_ose_RUN_ERL_LM_CONF` - run_erl_lm OSE load module configuration file
-erl_xcomp_ose_RUN_ERL_LM_CONF="${ERL_TOP}/erts/etc/ose/etc.lmconf"
-
-# * `erl_xcomp_ose_EPMD_LM_CONF` - epmd OSE load module configuration file
-erl_xcomp_ose_EPMD_LM_CONF="${ERL_TOP}/erts/etc/ose/etc.lmconf"
-
-# * `erl_xcomp_ose_CONFD` - OSE confd source file
-erl_xcomp_ose_CONFD="${OSEROOT}/src/ose_confd.c"
-
-# * `erl_xcomp_ose_CRT0_LM` - OSE crt0 lm source file
-erl_xcomp_ose_CRT0_LM="${OSEROOT}/src/crt0_lm.c"
-
-
-## -----------------------------------------------------------------------------
diff --git a/xcomp/erl-xcomp-sfk-linux-ose5.conf b/xcomp/erl-xcomp-sfk-linux-ose5.conf
deleted file mode 100644
index a4d64e5636..0000000000
--- a/xcomp/erl-xcomp-sfk-linux-ose5.conf
+++ /dev/null
@@ -1,305 +0,0 @@
-## -*-shell-script-*-
-##
-## %CopyrightBegin%
-##
-## Copyright Ericsson AB 2009-2012. All Rights Reserved.
-##
-## Licensed under the Apache License, Version 2.0 (the "License");
-## you may not use this file except in compliance with the License.
-## You may obtain a copy of the License at
-##
-## http://www.apache.org/licenses/LICENSE-2.0
-##
-## Unless required by applicable law or agreed to in writing, software
-## distributed under the License is distributed on an "AS IS" BASIS,
-## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-## See the License for the specific language governing permissions and
-## limitations under the License.
-##
-## %CopyrightEnd%
-##
-## File: erl-xcomp-sfk-linux-ose5.conf
-## Author: Petre Pircalabu
-##
-## -----------------------------------------------------------------------------
-## When cross compiling Erlang/OTP using `otp_build', copy this file and set
-## the variables needed below. Then pass the path to the copy of this file as
-## an argument to `otp_build' in the configure stage:
-## `otp_build configure --xcomp-conf=<FILE>'
-## -----------------------------------------------------------------------------
-
-## Note that you cannot define arbitrary variables in a cross compilation
-## configuration file. Only the ones listed below will be guaranteed to be
-## visible throughout the whole execution of all `configure' scripts. Other
-## variables needs to be defined as arguments to `configure' or exported in
-## the environment.
-
-## -- Variables needed for an OSE5 build ---------------------------------------
-OSEROOT="/vobs/ose5/system"
-HOST="linux"
-GCCVERSION="4.6.3"
-GCCROOT="${OSEROOT}/gcc_linux_x86_${GCCVERSION}"
-GCCTARGET="i386-elf"
-
-## -- Variables for `otp_build' Only -------------------------------------------
-
-## Variables in this section are only used, when configuring Erlang/OTP for
-## cross compilation using `$ERL_TOP/otp_build configure'.
-
-## *NOTE*! These variables currently have *no* effect if you configure using
-## the `configure' script directly.
-
-# * `erl_xcomp_build' - The build system used. This value will be passed as
-# `--build=$erl_xcomp_build' argument to the `configure' script. It does
-# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full
-# `CPU-VENDOR-OS' triplet will be created by
-# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess',
-# the build system will be guessed using
-# `$ERL_TOP/erts/autoconf/config.guess'.
-erl_xcomp_build=guess
-
-# * `erl_xcomp_host' - Cross host/target system to build for. This value will
-# be passed as `--host=$erl_xcomp_host' argument to the `configure' script.
-# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The
-# full `CPU-VENDOR-OS' triplet will be created by
-# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'.
-erl_xcomp_host="$GCCTARGET-ose"
-
-# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the
-# `configure' script.
-erl_xcomp_configure_flags="--disable-threads --disable-smp-support --disable-kernel-poll --disable-hipe --without-termcap --without-javac --disable-dynamic-ssl-lib --disable-shared-zlib --without-ssl --enable-static-nifs --enable-static-nifs=$ERL_TOP/lib/asn1/priv/lib/powerpc-unknown-ose/asn1rt_nif.a"
-
-## -- Cross Compiler and Other Tools -------------------------------------------
-
-## If the cross compilation tools are prefixed by `<HOST>-' you probably do
-## not need to set these variables (where `<HOST>' is what has been passed as
-## `--host=<HOST>' argument to `configure').
-
-## All variables in this section can also be used when native compiling.
-
-# * `CC' - C compiler.
-CC="$GCCROOT/bin/$GCCTARGET-gcc"
-
-# * `CFLAGS' - C compiler flags.
-CFLAGS="-g -fno-strict-aliasing -fno-builtin -fshort-wchar -Wall -Wno-unknown-pragmas -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/ose_spi -I$OSEROOT/include/gcc -MD -MP -D__OSE__ -DLITTLE_ENDIAN -DCF_CONF_SIZE=0x800"
-
-# * `STATIC_CFLAGS' - Static C compiler flags.
-#STATIC_CFLAGS=
-
-# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library
-# search path for the shared libraries. Note that this actually is a
-# linker flag, but it needs to be passed via the compiler.
-#CFLAG_RUNTIME_LIBRARY_PATH=
-
-# * `CPP' - C pre-processor.
-#CPP=
-
-# * `CPPFLAGS' - C pre-processor flags.
-CPPFLAGS="-g -fno-strict-aliasing -fno-builtin -fshort-wchar -Wall -Wno-unknown-pragmas -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/ose_spi -I$OSEROOT/include/gcc -MD -MP -D__OSE__ -DLITTLE_ENDIAN -DCF_CONF_SIZE=0x800"
-
-# * `CXX' - C++ compiler.
-#CXX=
-
-# * `CXXFLAGS' - C++ compiler flags.
-CXXFLAGS="-g -fno-strict-aliasing -ansi -I$GCCROOT/include/c++/$GCCVERSION -I$OSEROOT/include -I$OSEROOT/include/gcc "
-
-# * `LD' - Linker.
-LD="$GCCROOT/bin/$GCCTARGET-ld"
-
-# * `LDFLAGS' - Linker flags.
-LDFLAGS="-Wl,-ecrt0_lm -Wl,-T,$ERL_TOP/erts/emulator/sys/ose/gcc_lm_x86_$GCCVERSION.lcf"
-
-# * `LIBS' - Libraries.
-LIBS="$OSEROOT/lib/x86/libcrt.a $OSEROOT/lib/x86/libm.a $GCCROOT/lib/gcc/$GCCTARGET/$GCCVERSION/libgcc.a"
-
-## -- *D*ynamic *E*rlang *D*river Linking --
-
-## *NOTE*! Either set all or none of the `DED_LD*' variables.
-
-# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers.
-#DED_LD=
-
-# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'.
-#DED_LDFLAGS=
-
-# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library
-# search path for shared libraries when linking with `DED_LD'.
-#DED_LD_FLAG_RUNTIME_LIBRARY_PATH=
-
-## -- Large File Support --
-
-## *NOTE*! Either set all or none of the `LFS_*' variables.
-
-# * `LFS_CFLAGS' - Large file support C compiler flags.
-#LFS_CFLAGS=
-
-# * `LFS_LDFLAGS' - Large file support linker flags.
-#LFS_LDFLAGS=
-
-# * `LFS_LIBS' - Large file support libraries.
-#LFS_LIBS=
-
-## -- Other Tools --
-
-# * `RANLIB' - `ranlib' archive index tool.
-RANLIB="$GCCROOT/bin/$GCCTARGET-ranlib"
-
-# * `AR' - `ar' archiving tool.
-AR="$GCCROOT/bin/$GCCTARGET-ar"
-
-# * `STRIP' - `strip
-STRIP="$GCCROOT/bin/$GCCTARGET-strip"
-
-# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is
-# currently used for finding out large file support flags to use, and
-# on Linux systems for finding out if we have an NPTL thread library or
-# not.
-#GETCONF=
-
-## -- Cross System Root Locations ----------------------------------------------
-
-# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross
-# compilation environment. Currently, the `crypto', `odbc', `ssh' and
-# `ssl' applications need the system root. These applications will be
-# skipped if the system root has not been set. The system root might be
-# needed for other things too. If this is the case and the system root
-# has not been set, `configure' will fail and request you to set it.
-erl_xcomp_sysroot="$OSEROOT"
-
-# * `erl_xcomp_isysroot' - The absolute path to the system root for includes
-# of the cross compilation environment. If not set, this value defaults
-# to `$erl_xcomp_sysroot', i.e., only set this value if the include system
-# root path is not the same as the system root path.
-erl_xcomp_isysroot="$OSEROOT/include"
-
-## -- Optional Feature, and Bug Tests ------------------------------------------
-
-## These tests cannot (always) be done automatically when cross compiling. You
-## usually do not need to set these variables. Only set these if you really
-## know what you are doing.
-
-## Note that some of these values will override results of tests performed
-## by `configure', and some will not be used until `configure' is sure that
-## it cannot figure the result out.
-
-## The `configure' script will issue a warning when a default value is used.
-## When a variable has been set, no warning will be issued.
-
-# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes',
-# the target system must have a working `__after_morecore_hook' that can be
-# used for tracking used `malloc()' implementations core memory usage.
-# This is currently only used by unsupported features.
-#erl_xcomp_after_morecore_hook=
-
-# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system
-# must be big endian. If `no', little endian. This can often be
-# automatically detected, but not always. If not automatically detected,
-# `configure' will fail unless this variable is set. Since no default
-# value is used, `configure' will try to figure this out automatically.
-#erl_xcomp_bigendian=
-
-# * `erl_xcomp_double_middle` - `yes|no`. No default. If `yes`, the
-# target system must have doubles in "middle-endian" format. If
-# `no`, it has "regular" endianness. This can often be automatically
-# detected, but not always. If not automatically detected,
-# `configure` will fail unless this variable is set. Since no
-# default value is used, `configure` will try to figure this out
-# automatically.
-#erl_xcomp_double_middle_endian
-
-# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes',
-# the target system must have a working `clock_gettime()' implementation
-# that can be used for retrieving process CPU time.
-#erl_xcomp_clock_gettime_cpu_time=
-
-# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target
-# system must have a working `getaddrinfo()' implementation that can
-# handle both IPv4 and IPv6.
-#erl_xcomp_getaddrinfo=
-
-# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes',
-# the target system must have a working `gethrvtime()' implementation and
-# is used with procfs `ioctl()'.
-#erl_xcomp_gethrvtime_procfs_ioctl=
-
-# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the
-# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation
-# that can be used on `brk' and `sbrk' symbols used by the `malloc()'
-# implementation in use, and by this track the `malloc()' implementations
-# core memory usage. This is currently only used by unsupported features.
-#erl_xcomp_dlsym_brk_wrappers=
-
-# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target
-# system must have a working `kqueue()' implementation that returns a file
-# descriptor which can be used by `poll()' and/or `select()'. If `no' and
-# the target system has not got `epoll()' or `/dev/poll', the kernel-poll
-# feature will be disabled.
-#erl_xcomp_kqueue=
-
-# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on
-# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on
-# the target system must work. This variable is recommended to be set to
-# `no' on Linux systems with kernel versions less than 2.6.
-#erl_xcomp_linux_clock_gettime_correction=
-
-# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise,
-# `no'. If `yes', the target system must have NPTL (Native POSIX Thread
-# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux
-# kernel versions typically less than 2.6).
-#erl_xcomp_linux_nptl=
-
-# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux;
-# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target
-# system. `sigaltstack()' on Linux kernel versions less than 2.4 are
-# broken.
-#erl_xcomp_linux_usable_sigaltstack=
-
-# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes',
-# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old
-# LinuxThreads thread libraries (Linux kernel versions typically less than
-# 2.2) used these signals and made them unusable by the ERTS.
-#erl_xcomp_linux_usable_sigusrx=
-
-# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise,
-# `yes'. If `yes', the target system must have a working `poll()'
-# implementation that also can handle devices. If `no', `select()' will be
-# used instead of `poll()'.
-erl_xcomp_poll=no
-
-# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target
-# system must have a `putenv()' implementation that stores a copy of the
-# key/value pair.
-#erl_xcomp_putenv_copy=
-
-# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target
-# system must have reliable floating point exceptions.
-#erl_xcomp_reliable_fpe=
-
-# * `erl_xcomp_ose_ldflags_pass1` - Linker flags for the OSE module (pass 1)
-erl_xcomp_ose_ldflags_pass1="-r --no-omagic"
-
-# * `erl_xcomp_ose_ldflags_pass2` - Linker flags for the OSE module (pass 2)
-erl_xcomp_ose_ldflags_pass2="-n --emit-relocs -ecrt0_lm --no-omagic"
-
-# * `erl_xcomp_ose_OSEROOT` - OSE installation root directory
-erl_xcomp_ose_OSEROOT="$OSEROOT"
-
-# * `erl_xcomp_ose_STRIP` - Strip utility shipped with the OSE distribution
-erl_xcomp_ose_STRIP="$GCCROOT/bin/$GCCTARGET-strip"
-
-# * `erl_xcomp_ose_LM_POST_LINK` - OSE postlink tool
-erl_xcomp_ose_LM_POST_LINK="$OSEROOT/bin/$HOST/lm_post_link"
-
-# * `erl_xcomp_ose_LM_SET_CONF` - OSE load module configuration tool
-erl_xcomp_ose_LM_SET_CONF="$OSEROOT/bin/$HOST/lm_set_conf"
-
-# * `erl_xcomp_ose_LM_GET_CONF` - OSE load module elf size tool
-erl_xcomp_ose_LM_ELF_SIZE="$OSEROOT/bin/$HOST/lm_elf_size"
-
-# * `erl_xcomp_ose_LM_LCF` - OSE load module linker configuration file
-erl_xcomp_ose_LM_LCF="${ERL_TOP}/erts/emulator/sys/ose/gcc_lm_x86_$GCCVERSION.lcf"
-
-# * `erl_xcomp_ose_LM_CONF` - OSE load module default configuration file
-erl_xcomp_ose_LM_CONF="${ERL_TOP}/erts/emulator/sys/ose/default.lmconf"
-
-## -----------------------------------------------------------------------------
diff --git a/xcomp/erl-xcomp-vars.sh b/xcomp/erl-xcomp-vars.sh
index 0443867341..e864f7b96b 100644
--- a/xcomp/erl-xcomp-vars.sh
+++ b/xcomp/erl-xcomp-vars.sh
@@ -27,4 +27,4 @@
# and precious variables in $ERL_TOP/erts/aclocal.m4.
#
-erl_xcomp_vars="erl_xcomp_sysroot erl_xcomp_isysroot erl_xcomp_bigendian erl_xcomp_double_middle_endian erl_xcomp_linux_clock_gettime_correction erl_xcomp_linux_nptl erl_xcomp_linux_usable_sigusrx erl_xcomp_linux_usable_sigaltstack erl_xcomp_poll erl_xcomp_kqueue erl_xcomp_putenv_copy erl_xcomp_reliable_fpe erl_xcomp_getaddrinfo erl_xcomp_gethrvtime_procfs_ioctl erl_xcomp_clock_gettime_cpu_time erl_xcomp_after_morecore_hook erl_xcomp_dlsym_brk_wrappers erl_xcomp_posix_memalign erl_xcomp_ose_ldflags_pass1 erl_xcomp_ose_ldflags_pass2 erl_xcomp_ose_OSEROOT erl_xcomp_ose_STRIP erl_xcomp_ose_LM_POST_LINK erl_xcomp_ose_LM_SET_CONF erl_xcomp_ose_LM_GET_CONF erl_xcomp_ose_LM_ELF_SIZE erl_xcomp_ose_LM_LCF erl_xcomp_ose_BEAM_LM_CONF erl_xcomp_ose_EPMD_LM_CONF erl_xcomp_ose_RUN_ERL_LM_CONF erl_xcomp_ose_CONFD erl_xcomp_ose_CRT0_LM"
+erl_xcomp_vars="erl_xcomp_sysroot erl_xcomp_isysroot erl_xcomp_bigendian erl_xcomp_double_middle_endian erl_xcomp_linux_clock_gettime_correction erl_xcomp_linux_nptl erl_xcomp_linux_usable_sigusrx erl_xcomp_linux_usable_sigaltstack erl_xcomp_poll erl_xcomp_kqueue erl_xcomp_putenv_copy erl_xcomp_reliable_fpe erl_xcomp_getaddrinfo erl_xcomp_gethrvtime_procfs_ioctl erl_xcomp_clock_gettime_cpu_time erl_xcomp_after_morecore_hook erl_xcomp_dlsym_brk_wrappers erl_xcomp_posix_memalign"